prnval.asm
资源名称:DOS系统的源代码.rar [点击查看]
上传用户:xiaoan1112
上传日期:2013-04-11
资源大小:19621k
文件大小:27k
源码类别:
操作系统开发
开发平台:
Visual C++
- TITLE PRNVAL - Print values
- page 56,132
- ;***
- ; PRNVAL - Print values
- ;
- ; Copyright <C> 1986, Microsoft Corporation
- ;
- ;Purpose:
- ;
- ; This module contains B$P<term><type> and B$PEOS interfaces.
- ;
- ; The PRINT, WRITE, and LPRINT statements have a large number of
- ; runtime calls that can be generated, based on the list of
- ; expressions given. There is a unique preamble call for each such
- ; statement (except PRINT), to correctly set up flags, vectors, etc.
- ; The actual printing call itself is one of 15 possibilities, based
- ; on the argument type, and one of three possible ways of terminating
- ; the print: ',', ';', or EOL. Each of these 15 calls is in the
- ; form B$P<term><type> where <term> specifies the print termination
- ; method, and <type> specifies the type of the argument.
- ;
- ; <term>:
- ; C == ',' (i.e., something like 'PRINT X,' was specified)
- ; S == ';'
- ; E == EOL (neither ',' nor ';' was specified)
- ;
- ; <type>:
- ; I2 == two byte integer
- ; I4 == four byte integer
- ; R4 == single precision real
- ; R8 == double precision real
- ; SD == string
- ;
- ; Thus, for example, a call to B$PER4 would be used to print a s.p.
- ; value and terminate with a EOL.
- ;
- ; The list of expressions can be of any size; for each additional
- ; expression, another one of the fifteen possible runtime calls is
- ; generated. After the last such expression, a call to B$PEOS is
- ; generated (if not terminated with EOL). If no expression is
- ; specified, a NULL string is printed, so 'PRINT' would generate a
- ; call to B$PESD with a null string as the parameter (print a string,
- ; terminate with EOL).
- ;
- ;******************************************************************************
- INCLUDE switch.inc
- INCLUDE rmacros.inc
- ;Code segments:
- useSeg DK_TEXT ;disk I/O
- useSeg MT_TEXT ;floating point math.
- useSeg NH_TEXT ;near heap
- useSeg ER_TEXT ;error handling
- useSeg CN_TEXT ;concole I/O
- ;Data segments:
- useSeg CONST ;constant definitions
- useSeg _DATA ;initialized variables
- useSeg _BSS ;uninitialized variables
- INCLUDE seg.inc
- INCLUDE baslibma.inc
- INCLUDE devdef.inc
- INCLUDE files.inc
- INCLUDE rtps.inc ; constants shared with QBI
- INCLUDE idmac.inc
- SUBTTL local constant definitions
- page
- CLMWID EQU 14 ;column width
- COMA EQU 0 ;comma
- SEMI EQU 1 ;semicolumn
- EOL EQU 2 ;forced EOL
- TTY EQU 0 ;default for b$PTRFIL is TTY
- PRSTM EQU 0 ;print statement
- CHANL EQU 1 ;#
- USING EQU 2 ;using
- WRSTM EQU 4 ;write statement
- LPSTM EQU 8 ;lprint statement
- InpDefault EQU 0FFH ;default for b$Finput
- SUBTTL data definitions
- page
- sBegin CONST
- labelW TTYVEC ;vector for PRINT
- staticW ,B$TTY_GPOS ;cursor position
- staticW ,B$TTY_GWID ;line width
- staticW ,B$$TCR ;force EOL
- staticW ,B$TTY_SOUT ;write one character
- staticW ,B$TYPSTR ;write a string with BX=*sd
- staticW ,B$TYPCNT ;write a string with CX=length
- staticW ,B$OUTCNT ;write a string char. by char.
- staticW ,TTY_PRTCHK ; check if EOL needs to be forced
- sEnd
- sBegin _DATA
- externB b$PRFG ;print flag, may be combined from below
- ;0: PRINT stmt
- ;1: # (channel)
- ;2: USING
- ;4: WRITE stmt
- ;8: LPRINT stmt
- ;e.g. 3 means PRINT # USING
- labelW <PUBLIC,b$VECS> ; print value vectors
- staticW VPOS,B$TTY_GPOS ;cursor position
- staticW VWID,B$TTY_GWID ;line width
- staticW VWCLF,B$$TCR ;force EOL
- staticW VWCH,B$TTY_SOUT ;write one character
- staticW VTYP,B$TYPSTR ;BX=*sd
- staticW VTYPCNT,B$TYPCNT ;BX=*sd, CX=length
- staticW VOUTCNT,B$OUTCNT ;SI=point to string, CX=length
- staticW VPRTCHK,TTY_PRTCHK ; check if EOL needs to be forced
- SizeOfVecs EQU (($-b$VECS)/2) ;length of b$VECS table in words
- globalB b$FInput,InpDefault ;Where is input comming from
- globalW b$GetOneVal,<DK_TEXTOFFSET NoGetValAssert> ; vector
- ;to routine which INPUT will
- ;will use to get next data
- globalW b$pGetValDefault,<DK_TEXTOFFSET NoGetValAssert>
- ;if no input statement is
- ;present, attempts to call
- ;indirect through b$GetOneVal
- ;will die by assertion in
- ;non-release runtimes.
- globalW b$pFLUSH,Near_Ret,1 ;conditional vector for B$FLUSH
- externB b$CRTWIDTH ; screen width
- sEnd
- sBegin _BSS
- globalW b$PUSG,,1 ;print using routine
- EVEN ; for safety
- externW b$TempSD ; static string descriptor
- globalW b$StkBottom,,1 ; used to clean the stack after TTY inp
- externW b$?TYP ; [b$VTYP|b$TTYP] (defined in global.inc)
- externB b$VTYP ; value type (defined in global.inc)
- externB b$TTYP ; terminator type (defined in global.inc)
- externW b$PTRFIL ; print channel #
- externW b$pSTDALCTMP ; indirect B$STDALCTMP vector
- externB b$LPTFDB ; FDB for line printer
- externB b$Buf1
- sEnd
- SUBTTL code externals
- page
- sBegin DK_TEXT
- externNP B$CNTRL ; needed during B$WRIT
- sEnd
- sBegin MT_TEXT
- externNP B$FOUTBX
- sEnd
- sBegin CN_TEXT
- externNP B$TTY_GPOS ;cursor position
- externNP B$TTY_GWID ;line width
- externNP B$$TCR ;force EOL
- externNP B$TTY_SOUT ;write one character
- externNP B$TYPSTR ;write a string with BX=*sd
- externNP B$TYPCNT ;write a string with CX=length
- externNP B$OUTCNT ;write a string char. by char.
- sEnd
- assumes CS,DK_TEXT
- sBegin DK_TEXT
- SUBTTL print interfaces -- B$P<term><type>(<param>)
- page
- ;***
- ; B$P<term><type>(<param>) -- print an item for :
- ; PRINT, PRINT #, PRINT USING, PRINT # USING,
- ; WRITE, WRITE #,
- ; LPRINT, LPRINT USING.
- ;
- ;Purpose:
- ; These are interfaces to the compiler. Each entry point sets up
- ; (1) types of value & terminator, and
- ; (2) a pointer to that item,
- ; and then fall through PRINT, which performs actual printing job.
- ;
- ; <term>, <type> & <param> may vary as follows:
- ; <term>:
- ; C: Comma used as terminator
- ; S: Semi used as terminator
- ; E: End of statement used as terminator
- ; <type>:
- ; I2: Two byte integer
- ; I4: Four byte integer
- ; SD: String (string descriptor)
- ; <param>:
- ; A parameter of type <type> to be printed.
- ;
- ;
- ;Entry:
- ; Parameter was pushed in stack.
- ; <type> Val = Number if <type> is numerical type
- ; = String descriptor if <type> is string
- ;
- ;Exit:
- ; through B$PRINT
- ;Uses:
- ; none
- ;Exceptions:
- ;
- ;*******************************************************************************
- ;========================
- ; Print I2, |
- ;========================
- cProc B$PCI2,<PUBLIC,FAR>
- cBegin nogen ;no stack frame generated
- MOV AX,COMA SHL 8 + VT_I2 ;AX=[terminator type | value type]
- JMP SHORT B$PRINT ;print this item
- cEnd nogen ;no code generated
- ;========================
- ; Print I2; |
- ;========================
- cProc B$PSI2,<PUBLIC,FAR>
- cBegin nogen ;no stack frame generated
- MOV AX,SEMI SHL 8 + VT_I2 ;AX=[terminator type | value type]
- JMP SHORT B$PRINT ;print the item
- cEnd nogen ;no code generated
- ;========================
- ; Print I2 |
- ;========================
- cProc B$PEI2,<PUBLIC,FAR>
- cBegin nogen ;no stack frame generated
- MOV AX,EOL SHL 8 + VT_I2 ;AX=[terminator type | value type]
- JMP SHORT B$PRINT ;print the item
- cEnd nogen ;no code generated
- ;========================
- ; Print I4, |
- ;========================
- cProc B$PCI4,<PUBLIC,FAR>
- cBegin nogen ;no stack frame generated
- MOV AX,COMA SHL 8 + VT_I4 ;AX=[terminator type | value type]
- JMP SHORT B$PRINT ;print the item
- cEnd nogen ;no code generated
- ;========================
- ; Print I4; |
- ;========================
- cProc B$PSI4,<PUBLIC,FAR>
- cBegin nogen ;no stack frame generated
- MOV AX,SEMI SHL 8 + VT_I4 ;AX=[terminator type | value type]
- JMP SHORT B$PRINT ;print the item
- cEnd nogen ;no code generated
- ;========================
- ; Print I4 |
- ;========================
- cProc B$PEI4,<PUBLIC,FAR>
- cBegin nogen ;no stack frame generated
- MOV AX,EOL SHL 8 + VT_I4 ;AX=[terminator type | value type]
- JMP SHORT B$PRINT ;print the item
- cEnd nogen ;no code generated
- ;========================
- ; Print a$, |
- ;========================
- cProc B$PCSD,<PUBLIC,FAR>
- cBegin nogen ;no stack frame generated
- MOV AX,COMA SHL 8 + VT_SD ;AX=[terminator type | value type]
- JMP SHORT B$PRINT ;print the item
- cEnd nogen ;no code generated
- ;========================
- ; Print a$; |
- ;========================
- cProc B$PSSD,<PUBLIC,FAR>
- cBegin nogen ;no stack frame generated
- MOV AX,SEMI SHL 8 + VT_SD ;AX=[terminator type | value type]
- JMP SHORT B$PRINT ;print the item
- cEnd nogen ;no code generated
- ;========================
- ; Print a$ |
- ;========================
- cProc B$PESD,<PUBLIC,FAR>
- cBegin nogen ;no stack frame generated
- MOV AX,EOL SHL 8 + VT_SD ;AX=[terminator type | value type]
- cEnd nogen ;no code generated
- SUBTTL actual routine to print an item
- page
- ;***
- ;B$PRINT - continue the print interfaces to print an item
- ;
- ;Purpose:
- ; Print an item for PRINT/WRITE/LPRINT statement.
- ;
- ; Printing an item is affected by:
- ; (1) whether it's a 'print using'
- ; (2) whether it prints a string (numbers need to be translated)
- ; (3) whether it is a print stmt or is a write stmt.
- ; In case of write stmt, the following are different:
- ; (a) no leading blank for a positive number if '+' omitted
- ; (b) no ending space for a number
- ; (c) string delimited by '"'
- ; (d) comma delimiting items
- ;
- ; One major difference here is that numbers also use the string output
- ; routine to print on a device. The string output routine outputs one
- ; string a time, if it fits the rest of the line, which is faster than
- ; iteratively outputs one character a time.
- ;
- ; Certainly, one piece of code, which serves such many functions, can't
- ; be as clean as some simple routines do. However, there still has its
- ; logic as follows:
- ;
- ; B$PRINT (TerminatorType_&_ValueType)
- ; {
- ; if channel on, test the mode is not input
- ; if error then give "bad file mode"
- ; get pointer of the item to be printed from stack
- ; set up types
- ;
- ; /* print the item */
- ;
- ; if the request was PRINT USING, then
- ; call print using routine
- ; else /* not a PRINT USING */
- ; if the request was printing a number, then
- ; translate the number into digital string
- ; if the request was a WRITE statement, then
- ; special process the leading & ending space
- ; else /* printing a string */
- ; if the request was a WRITE statement, then
- ; special process the string delimitor
- ; print the string
- ;
- ; /* process the terminator */
- ;
- ; if the terminator was a EOL, then force a carrage return
- ; if the terminator was a COMMA, then fill the rest of the column
- ; with blanks
- ; if the terminator was a SEMI-COLUMN and the request was a WRITE
- ; statement, then print a ','
- ;
- ; /* handle the exit process explicitly */
- ;
- ; play around with BP and SP
- ;
- ; /* When exit the stack looks like : */
- ; /* __________________ */
- ; /* | SI | */
- ; /* |----------------| */
- ; /* | DS (if ?WIN) | */
- ; /* BP -->|----------------| */
- ; /* | BP | */
- ; /* |----------------| */
- ; /* | Ret offset | */
- ; /* |----------------| */
- ; /* | Ret segment | */
- ; /* Val -->|----------------| */
- ; /* | Parameter | */
- ; /* (variable len) ................ */
- ; /* ................ */
- ; /* old SP -->|----------------| */
- ; /* |________________| */
- ; /* */
- ; }
- ;Entry:
- ; [AH] = [terminator type]
- ; [AL] = [value type]
- ; in stack,
- ; Val = first word of item, where item is either I2,I4,R4,R8 or sd/psd
- ;Exit:
- ; none
- ;Uses:
- ; none
- ;Exceptions:
- ; bad file mode
- ; I/O error or Disk full error when flush the buffer if a EOL encountered
- ;*******************************************************************************
- ;NOTE!: This routine has a manually
- ;generated epilogue due to variable number
- ;of parameters. If you change the prologue,
- ;here you must also change the epilogue
- ;further down.
- cProc B$PRINT,<PUBLIC,FAR>,<SI> ;common routine, has to be declared
- ; as FAR for setting up stack frame correctly.
- ; SI saved
- ParmW Val ;dummy parameter, which points to the first
- ; byte of the actual parameter regardless how
- ; many bytes it is; this also forces to set
- ; up the stack frame
- cBegin ;stack frame is set up and SI is saved
- MOV [b$?TYP],AX ;set up b$VTYP & b$TTYP
- LEA BX,Val ;get the address of parameter
- CMP AL,VT_SD ; is this a string parm?
- JNZ ChkString ; brif not - BX has the pointer to the value
- MOV BX,[BX] ; if SD, BX has the value, not pointer
- ChkString:
- TEST [b$PRFG],USING ;is print using on ?
- JNZ PRTUSG ;Brif yes
- CMP AL,VT_SD ;printing a string ?
- JZ PRTSTR ;Brif yes
- ;[2] At this moment, [BX]=*I2,*I4,*R4 or *R8.
- ; Currently B$FOUTBX changes all registers except BP. This has to be
- ; changed later on.
- CALL B$FOUTBX ; Hopefully, the return from B$FOUTBX
- ; are BX containing the address of the
- ; string and AX is the length
- MOV SI,BX ; SI=*Number
- TEST [b$PRFG],WRSTM ;is write statement on ?
- JNZ WRTVAL ;Brif is write stmt
- ADD BX,AX ;bx points to the terminate byte (00)
- INC AX ;increment the length of the digital string
- MOV BYTE PTR [BX]," " ;Number always followed by " "
- ;Note: the static buffer for translating a
- ; number must at least one byte longer
- ; than the maximum possible length.
- cCall MAKESD ;[BX]=*sd on return
- PRTIT1: ;at this entry, check whether a EOL is needed
- PUSH BX ;save psd
- cCall [VPRTCHK] ; CY if room is not enough (possibly a EOL
- ; was already forced), needs AX=len of string
- POP BX ;get back psd
- PRTIT2: ;at this entry, no check for EOL (write)
- PUSH BX ; save psd
- CALL [VTYP] ;print the string, needs [BX]=psd
- POP BX ; get back psd
- CALL [b$pSTDALCTMP] ; deallocate the temp if it is
- PRTEND:
- MOV AL,[b$TTYP] ; get delimiter type
- CBW ; extend to use word ops
- DEC AX ; test for EOL delimiter
- JG PRTCLF ; Brif end with LF-CR
- TEST [b$PRFG],WRSTM ;is write stmt on ?
- JZ PRTEND2 ; Brif not
- MOV AL,"," ; here if comma or semi and write stmt
- CALL [VWCH] ;write the character
- JMP SHORT PRINTX ;exit to caller
- WRTVAL: ;write stmt take off the leading " "
- CMP BYTE PTR [BX]," " ;is first a blank ?
- JNZ WTMKSD ;Brif not, go make sd & print it
- INC SI ;skip the leading blank if write statement
- DEC AX ;decrement the length
- WTMKSD:
- cCall MAKESD ;[BX]=*sd
- JMP SHORT PRTIT2 ;go print it
- PRTUSG:
- ; print using, so make QBI compatable.
- CMP AH,COMA ; PRINT USING COMMA?
- JNE NotComma ; brif not -- don't alter terminator
- MOV b$TTYP,SEMI ; change comma to semicolon
- NotComma:
- CALL [b$PUSG] ;print using is handled specially
- JMP SHORT PRTEND ;process the terminator
- PRTSTR: ;when enter, BX=*sd
- MOV AX,[BX] ; AX = length of string
- TEST [b$PRFG],WRSTM ; is write stmt on ?
- JZ PRTIT1 ;Brif not, go printing string
- MOV AL,'"' ;'"' is the delimitor of write string
- PUSH BX ; save psd
- CALL [VWCH] ;print '"'
- POP BX ; restore psd
- CALL [VTYP] ;output the string
- CALL [b$pSTDALCTMP] ; deallocate the temp if it is
- MOV AL,'"' ;'"' is the delimitor of write string
- CALL [VWCH] ;print it
- JMP SHORT PRTEND ;process the terminator
- PRTCLF:
- CALL [VWCLF] ;force a EOL
- cCall BPEOS ;epilog for PRINT
- JMP SHORT PRINTX ;exit to caller
- PRTEND2: ; here if comma or semi and NOT write stmt
- INC AX ; test for semi delimitor
- JNZ PRINTX ; go exit, done if semi-colon
- PRTCMA:
- CALL [VPOS] ;[AH]=current cursor position
- MOV AL,AH ;position in AL
- XOR AH,AH ;prepare for DIV
- ;Note: can't use CBW here, since the range
- ; is 0 - 255 (unsigned)
- MOV CL,CLMWID ;get field length
- DIV CL ;AH=remainder, is the position in this column
- SUB CL,AH ;spaces needed to fill this column
- XCHG AX,CX ; put count in AL
- CBW ;extend to a word
- PUSH AX ;save count of patching spaces
- ADD AX,CLMWID ;account for width of next column
- cCall [VPRTCHK] ; CY if room is not enough to fit (possibly
- ; a EOL was forced)
- POP CX ;get back count in CX
- JB PRINTX ;no need to patch spaces
- CALL B$OutBlanks ; output CX blanks
- PRINTX: ;pop SI & exit to caller
- POP SI ; restore
- POP BP
- POP CX ; [CX] = return offset
- POP DX ; [DX:CX] = return address
- POP BX ; discard 1st word of parameter
- MOV AL,BYTE PTR [b$?TYP] ; [AL] = type byte
- TEST AL,VT_SD ; NZ if I2 or SD, i.e., if 1-word parm
- JNZ PRINTX_5 ; Jump if we don't need to pop more
- POP BX ; Discard 2nd word of parameter
- TEST AL,8 ; R8 or currency (8-byte values)?
- JZ PRINTX_5 ; no, don't pop any more
- POP BX ; discard 3rd word of parameter
- POP BX ; discard 4th word of parameter
- PRINTX_5:
- PUSH DX ; put back seg...
- PUSH CX ; ... and offset of far return address
- RET ; and return
- cEnd nogen ;no code generated
- SUBTTL supporting routines for print an item
- page
- ;***
- ;PRTCHK -- check whether there is room for the printing string
- ;
- ;Purpose:
- ; Check whether there is room for the printing string. If it isn't,
- ; force a EOL if the current position is not in col. 1.
- ;
- ; Prtchk(len_of_str)
- ; register int len_of_str
- ; {
- ; register int d_width
- ; register int current_pos
- ;
- ; if ((d_width=vwid()) != 255)
- ; if ( (len_of_str > 255) ||
- ; ((d_width - (current_pos=vpos()) - len_of_str) < 0) )
- ; { if (current_pos != 0) /* 0-relative */
- ; vclf()
- ; Set_CY
- ; }
- ; }
- ;
- ;Entry:
- ; register AX = len_of_str
- ;
- ;Exit:
- ; CY if room left is not enough (may or may not force a EOL)
- ;
- ;Uses:
- ; None
- ;
- ;Exceptions:
- ; None
- ;*******************************************************************************
- cProc B$PRTCHK,<NEAR,PUBLIC>
- cBegin
- XCHG DX,AX ; length in DX
- CALL [VWID] ;[AH] = device width
- CMP AH,255 ;is device a file ?
- JZ CHKEXT ;exit (with NC)
- MOV AL,AH ;[AL] = device width
- JMP SHORT PRTCHK1
- cEnd <nogen>
- cProc TTY_PRTCHK,<NEAR>
- cBegin
- XCHG DX,AX ; length in DX
- MOV AL,b$CRTWIDTH ; AL = device width
- PRTCHK1:
- CALL [VPOS] ;[AH] = current position
- OR DH,DH ; more than 255 char to print?
- JNZ FORCE ; force a EOL
- SUB AL,AH ;amount left on line
- JB FORCE ;If no room on line, need new line
- CMP AL,DL ;will amount requested fit?
- JAE CHKEXT ;exit (with NC)
- FORCE:
- OR AH,AH ;is current position 0 (at col 1)
- JZ NOCRLF ;do not print EOL if at col 1
- CALL [VWCLF] ;force EOL
- NOCRLF:
- STC ;indicate room is not enough
- Near_Ret: ;near return for vector
- CHKEXT:
- cEnd ;end of PRTCHK
- ;***
- ;MAKESD -- make a static string descriptor
- ;
- ;Purpose:
- ; Make a static string descriptor (in b$TempSD) which points to the
- ; input string. Major changes with revision [38].
- ;
- ; WARNING !!! This routine assumes that the word preceding the string
- ; WARNING !!! is available to be used as the string header
- ;
- ;Entry:
- ; [SI] = address of the string
- ; [AX] = length of the string
- ;
- ;Exit:
- ; [BX] = address of static descriptor (b$TempSD)
- ; b$TempSD & b$TempStrPtr set up as SD.
- ;
- ;Uses:
- ; Backs up SI by 2.
- ;
- ;*******************************************************************************
- cProc MAKESD,<NEAR> ;private local routine
- cBegin
- MOV BX,OFFSET DGROUP:b$TempSD ; get the offset
- MOV WORD PTR [BX],AX ; length goes first
- MOV WORD PTR [BX+2],SI ; string pointer next
- cEnd
- ;***
- ;BPEOS -- actual code to terminate a print statement.
- ;
- ;Purpose:
- ; This routine is called by either the interface B$PEOS or B$PExx
- ; (print an item which terminated with a EOL)
- ; If FV_FARSTR, deallocate "using" string here if it was a temp.
- ;Entry:
- ; b$PTRFIL is the pointer/handle to FDB
- ;Exit:
- ; b$PTRFIL & b$PRFG are reset
- ;Uses:
- ; none
- ;Exceptions:
- ; I/O error or disk full error (when flush the buffer)
- ;*******************************************************************************
- cProc BPEOS,<NEAR>,<SI> ;was part of $PV4, SI saved
- cBegin
- MOV SI,[b$PTRFIL] ;get the pointer to FDB
- OR SI,SI ;is file 0 ? (TTY)
- JZ PEOSX ;Brif tty output, reset flags and exit
- MOV [b$PTRFIL],TTY ; clear out active FDB block
- FDB_PTR ES,SI,SI ;(ES:)[SI] = *FDB
- CMP SI,OFFSET DGROUP:b$LPTFDB ;is line printer ?
- JE PEOSX ;Brif LPRINT
- TEST FileDB.FD_FLAGS,FL_CHAR ;check for character device file
- JZ PEOSX ;Brif not character device
- CALL [b$pFLUSH] ; is character device, flush buffer
- ; was save and restore registers AX,BX,CX &
- ; DX in $PV4
- PEOSX:
- TEST [b$PRFG],WRSTM+LPSTM+CHANL ;was LPRINT, WRITE or # ?
- MOV [b$PRFG],PRSTM ;reset the print flag
- JZ NoSetVec
- MOV SI,OFFSET DGROUP:TTYVEC
- ;get source to fill in
- cCall B$WCHSET ;reset vector to default, needs SI
- NoSetVec:
- cEnd ;pop SI & exit to caller
- SUBTTL print/input interface -- B$PEOS [4]
- page
- ;***
- ;B$PEOS -- epilog for PRINT/WRITE/LPRINT/INPUT[#]/READ
- ;
- ;Purpose:
- ; if print, then clear out active FDB block, and flush buffer in case
- ; of a character device, also reset print flags
- ; if input, reset input flag & variable
- ;
- ; NOTE: this routine plays around with the stack pointer and stack frame
- ; pointer (BP). Be really careful when save something in the
- ; stack.
- ;Entry:
- ; [b$PTRFIL] is the pointer to FDB
- ; [b$FInput] is the flag for input
- ; [b$PRFG] is the flag for print
- ;Exit:
- ; b$PTRFIL & b$PRFG & b$FInput (also b$GetOneVal) are reset
- ;Uses:
- ; none
- ;Exceptions:
- ; I/O error or disk full error (when flush the buffer (BPEOS))
- ;*******************************************************************************
- cProc B$PEOS,<PUBLIC,FAR>
- cBegin
- PUSH BP
- MOV BP,SP ;set up stack frame explicitly, since error
- ; could happen when flushing the buffer
- PUSH ES
- MOV AL,[b$Finput] ; get flag
- OR AL,AL ; test it
- JS TryPrint ; either READ stmt or default, try print
- JNZ RstFlags ; was disk input, just reset flags
- PUSH SI ; save SI
- PUSH DI ; save DI
- MOV DI,[b$StkBottom] ; DI is the stack bottom
- DEC DI ; one word above
- DEC DI
- MOV SI,SP ; SI points to the BP
- ADD SI,10 ;[12] SI points to ret_seg
- MOV CX,3 ; 3 words to move
- STD ; the move has to be from memory high to
- ; low to avoid overlapping
- PUSH DS
- POP ES
- REP MOVSW ; mov BP and return addr to new location
- CLD ; clear direction
- MOV BP,DI ; stack frame has to be changed
- ADD BP,2 ; new locaton of old BP (later on,
- ; "MOV SP,BP" will clean the stack)
- POP DI ; get back DI
- POP SI ; get back SI
- RstFlags:
- cCall B$InpReset ; reset input flag if this is input stmt
- JMP SHORT EosExit
- TryPrint: ; either print or READ stmt may be here,
- ; however, next call, BPEOS, won't hurt
- ; if it is READ stmt
- cCall BPEOS ;try print flush the buffer and reset flags
- EosExit:
- POP ES
- MOV SP,BP ;remove stack frame
- POP BP
- cEnd ;pop BP & exit
- SUBTTL set up print dispatch vector
- page
- ;***
- ;B$WCHSET -- set up print dispatch vector
- ;
- ;Purpose:
- ; b$VECS is the dispatch vector for PRINT/WRITE/LPRINT, which contains
- ; the address for different functions. The functions are:
- ; b$VECS:
- ; VPOS -- current cursor position
- ; VWID -- device line width
- ; VWCLF -- force EOL
- ; VWCH -- write one character
- ; VTYP -- write a string with a given *sd
- ; VTYPCNT -- write a string with length in CX
- ; VOUTCNT -- write a string char. by char.
- ; VPRTCHK -- check if EOL needs to be forced
- ;Entry:
- ; [SI] points to the source which will fill in the b$VECS
- ;Exit:
- ; b$VECS is set up
- ;Uses:
- ; SI
- ;Exceptions:
- ; none
- ;*******************************************************************************
- cProc B$WCHSET,<PUBLIC,NEAR>,<DI,ES> ;save ES,DI
- cBegin
- PUSH DS
- POP ES ; can't assume ES=DS, set them equal
- MOV DI,OFFSET DGROUP:b$VECS
- MOV CX,SizeOfVecs ;count of words to copy
- REP MOVSW
- cEnd ;pop DI,ES and exit to caller
- ;***
- ; B$OutBlanks -- output a string of blanks. Added with [22].
- ;
- ;Purpose:
- ; Save some code, and eliminate a static buffer of blanks.
- ; Doesn't print anything if count not in range 1-32767.
- ;
- ;Entry:
- ; CX = number of blanks to output
- ;Exit:
- ; None
- ;Uses:
- ; Per convention
- ;Exceptions:
- ; None
- ;
- ;******************************************************************************
- cProc B$OutBlanks,<PUBLIC,NEAR>,<SI,DI> ; Save SI,DI
- cBegin
- OR CX,CX ; negative or zero byte count
- JLE OutExit ; brif no blanks to output
- DbAssertRel CX,BE,2*FILNAML,DK_TEXT,<B$OutBlanks: cnt too large>
- PUSH CX ;save cnt
- PUSH SS ;ES = DGROUP
- POP ES
- MOV DI,OFFSET DGROUP:b$Buf1
- PUSH DI
- INC CX ;round byte count to word count
- SHR CX,1
- MOV AX,' '
- REP STOSW ;fill with spaces
- POP SI ;DS:SI = string
- POP CX ;CX = count
- CALL [VOUTCNT] ;print the spaces
- OutExit:
- cEnd ;exit to caller
- page
- ;***
- ;NoGetValAssert - Assertion code for calls through [b$GetOneVal].
- ;
- ;Purpose:
- ; The variable [b$GetVal] is reset with common code to point to
- ; the default READ/INPUT entry point. When no INPUT/READ statement
- ; is used in a program linked /O, there is no need to drag in the
- ; READ code. So, b$GetVal is initialized to point to this routine
- ; for this case. If someone inadvertently tries to call through
- ; b$GetVal when no READ/INPUT code is loaded, it will be caught here.
- ; Added with revision [27].
- ;Entry:
- ; none
- ;Exit:
- ; none
- ;Uses:
- ; none
- ;Exceptions:
- ; none
- ;*******************************************************************************
- cProc NoGetValAssert,<NEAR>
- cBegin
- DbHalt <DK_TEXT>,<Tried to call B$ReadVal when it wasn't loaded>
- cEnd
- page
- ;***
- ;B$InpReset -- reset flag and variables for INPUT related statement
- ;
- ;Purpose:
- ; Reset flag and variables for input related statement.
- ; Moved to this file with [23]
- ;
- ;Entry:
- ; none
- ;
- ;Exit:
- ; [b$FInput] = InpDefault
- ; [b$GetOneItem] = OFFSET B$ReadItem
- ; [b$PTRFIL] = TTY
- ;
- ;Uses:
- ; none
- ;
- ;Exceptions:
- ; none
- ;*******************************************************************************
- cProc B$InpReset,<PUBLIC,NEAR>
- cBegin
- MOV [b$FInput],InpDefault
- ;reset input flag
- ; If input was pulled in, then this points to B$ReadVal, if no READ/INPUT
- ; statement was used, then this really points to the assertion routine
- ; NoGetValAssert
- PUSH AX
- MOV AX,[b$pGetValDefault] ;get default value for READ/INPUT
- MOV [b$GetOneVal],AX ;reset get item routine
- POP AX
- MOV [b$PTRFIL],TTY ;reset to TTY
- cEnd ;exit to caller
- SUBTTL interface for WRITE preamble
- page
- ; B$WRIT moved here from PR0A.ASM and modified for greater /O modularity.
- ;Revision number [25] applies to entire routine.
- ;***
- ;B$WRIT -- preamble for WRITE statement [25]
- ;void B$WRIT(void)
- ;
- ;Purpose:
- ; This is the only preamble for WRITE statement. This routine sets up
- ; flag for WRITE statement. BASCOM 2.0 uses two preambles,
- ; $WRI for WRITE and $WRD for WRITE #.
- ;
- ; The flag, b$PRFG, is set to 4 (WRSTM) to indicate a WRITE statement
- ; is processing. If it is a WRITE #, then B$CHOU will OR the flag,
- ; b$PRFG, with 1 (CHANL) to indicate a special channel is being used.
- ;Entry:
- ; none
- ;Exit:
- ; b$PRFG is set to WRSTM (WRITE statement is on going)
- ; uses default vectors, same as PRINT.
- ;Uses:
- ; none
- ;Exceptions:
- ; none
- ;*******************************************************************************
- cProc B$WRIT,<PUBLIC,FAR,FORCEFRAME> ; stack frame generated explicitly
- cBegin
- OR [b$PRFG],WRSTM ; set flag indicating WRITE stmt is on going
- CALL B$CNTRL ; check for control chars during print
- cEnd ; return to caller
- sEnd ;end of DK_TEXT
- END