title 'PAN: Program ANimator by Pete Maclean'
include pan.hdr
; Symbol definitions
CR = 13 ; ASCII carriage return
LF = 10 ; ASCII linefeed
TAB = 9 ; ASCII Tab
; BIOS Keyboard Buffer definitions
KBB_SEGADD = 40h ; segment address of buffer
KBB_HEAD = 1Ah ; offset to head pointer
KBB_TAIL = 1Ch ; offset to tail pointer
KBB_START = 80h ; offset to start pointer
KBB_END = 82h ; offset to end pointer
; PAN States
PS_INITIAL = 0 ; initial state - no target program loaded
PS_LOADED = 1 ; target program loaded
PS_RUNNING = 2 ; target program running
PS_OBIT = 3 ; waiting for target program to die
PS_QUIT = 4 ; QUIT pending when target program dies
code segment para public 'code'
assume cs:code, ds:code
org 100h
start: jmp main ; entry point
; Messages
initmsg db 'PAN 1.0 (c) 1990 Ziff Communications Co.',CR,LF
db 'PC Magazine ',254,' Pete Maclean',CR,LF,'$'
crlfz db CR,LF,0
; Definition for command-table entry
COMMAND STRUC
PC_KEY dw ? ; (offset) address of command key
PC_PROC dw ? ; (offset) address of command processor
PC_TYPE db ? ; coded command type
COMMAND ENDS
command_entry_size db SIZE COMMAND
; Command types
PCT_REG = 0 ; regular command
PCT_IF = 2 ; If command
PCT_ELSE = 4 ; Else command
PCT_FI = 6 ; EndIf command
; Command table
command_table LABEL COMMAND
COMMAND <k_Break, c_Break, PCT_REG>
COMMAND <k_Cursor, c_Cursor, PCT_REG>
COMMAND <k_Else, c_Else, PCT_ELSE>
COMMAND <k_EndIf, c_EndIf, PCT_FI>
COMMAND <k_Flush, c_Flush, PCT_REG>
COMMAND <k_GetKey, c_GetKey, PCT_REG>
COMMAND <k_Go, c_Go, PCT_REG>
COMMAND <k_IfKey, c_IfKey, PCT_IF>
COMMAND <k_IfLoad, c_IfLoad, PCT_IF>
COMMAND <k_IfScreen, c_IfScreen, PCT_IF>
jump_command COMMAND <k_Jump, c_Jump, PCT_REG>
COMMAND <k_Key, c_Key, PCT_REG>
label_command COMMAND <k_Label, c_Label, PCT_REG>
COMMAND <k_Load, c_Load, PCT_REG>
COMMAND <k_Lock, c_Lock, PCT_REG>
COMMAND <k_Mode, c_Mode, PCT_REG>
COMMAND <k_Pause, c_Pause, PCT_REG>
COMMAND <k_Output, c_Output, PCT_REG>
COMMAND <k_Quit, c_Quit, PCT_REG>
COMMAND <k_Screen, c_Screen, PCT_REG>
setif_command COMMAND <k_SetIf, c_SetIf, PCT_REG>
COMMAND <k_TypeRate, c_TypeRate, PCT_REG>
COMMAND <k_Unlock, c_Unlock, PCT_REG>
COMMAND <k_Video, c_Video, PCT_REG>
COMMAND <k_WaitChild, c_WaitChild, PCT_REG>
COMMAND <k_WaitScreen, c_WaitScreen, PCT_REG>
COMMAND <k_WaitUntil, c_WaitUntil, PCT_REG>
COMMAND <k_Wipe, c_Wipe, PCT_REG>
JUMP_INDEX = (jump_command - command_table) / SIZE COMMAND
LABEL_INDEX = (label_command - command_table) / SIZE COMMAND
SETIF_INDEX = (setif_command - command_table) / SIZE COMMAND
; Command keywords
command_keys LABEL BYTE
k_Break db "Break",0
k_Cursor db "Cursor",0
k_Else db "Else",0
k_EndIf db "EndIf",0
k_Flush db "Flush",0
k_GetKey db "GetKey",0
k_Go db "Go",0
k_IfKey db "IfKey",0
k_IfLoad db "IfLoad",0
k_IfScreen db "IfScreen",0
k_Jump db "Jump",0
k_Key db "Key",0
k_Label db "Label",0
k_Load db "Load",0
k_Lock db "Lock",0
k_Mode db "Mode",0
k_Pause db "Pause",0
k_Output db "Output",0
k_Quit db "Quit",0
k_Screen db "Screen",0
k_SetIf db " SetIf",0 ; cannot be written
k_TypeRate db "TypeRate",0
k_Unlock db "Unlock",0
k_Video db "Video",0
k_WaitChild db "WaitChild",0
k_WaitScreen db "WaitScreen",0
k_WaitUntil db "WaitUntil",0
k_Wipe db "Wipe",0
db 0 ; end of table marker
; Key table for "On"/"Off" arguments:
on_off db 'OFF',0,'ON',0,0 ; Off is 0, On is 1
; Dispatch table for preprocessing commands by type
preprocessing_table LABEL WORD
dw pp_regular, pp_If, pp_Else, pp_EndIf
; Extra dispatch table for conditional commands
n_table dw n_Nop, n_If, c_Else, c_EndIf
; Miscellaneous stuff
pan_extension db '.PAN',0 ; Standard extension for Pan scripts
pan_sp dw 0 ; SP on transferring to a child program
break_condition db 0 ; ? break on or off
command_ptr dw script_buffer
current_command dw 0 ; pointer to current command in script_buffer
file_handle dw ? ; handle for command file
if_condition db 0 ; IF condition
if_effect_level db 0 ; Level at which last If was TRUE
if_nest_level db 0 ; IF condition level
in_pan_flag db 0 ; set non-zero when in Pan timer intercept
keyboard_feed db 0 ; set when PAN needs exclusive access
; to the keyboard
keyboard_state db 0 ; 0 => unlocked, 1 => locked
kbb_segment dw KBB_SEGADD ; memory segment of keyboard buffer
line_buffer db 128 dup (?) ; buffer for reading text through
pan_state db PS_INITIAL ; see list of PS_xxxx states above
screen_columns db 0 ; number of columns displayed in current video mode
recall_address dw 0 ; address to recall after timer expiry
time_out dw 0 ; time_out counter (ticks)
type_rate dw 0 ; simulation rate for typing
va db 70h ; video attribute, default like DOS MDA
video_segment dw 0 ; memory segment address of video buffer
; Saved BIOS-keyboard interrupt vector
i_BIOS_kb LABEL dword
x_bk_offset dw 0
x_bk_segment dw 0
; Saved timer interrupt vector
i_timer LABEL dword
x_timer_offset dw 0
x_timer_segment dw 0
; Saved keyboard interrupt vector
i_keyboard LABEL dword
x_key_offset dw 0
x_key_segment dw 0
; Saved Ctrl-Break interrupt vector
i_ctrl_break LABEL dwORD
x_break_offset dw 0
x_break_segment dw 0
; Stack pointer from intercept
callers_sp dw 0
callers_ss dw 0
; Last keypress obtained by a GetKey command
keypress LABEL WORD
key_ASCII db 0
key_scan db 0
; Screen position
screen_position LABEL word
n_col db 0 ; column number
n_row db 0 ; row number
; "Keyboard" Input Queue pointers
kiq_first dw 0 ; pointer to first/next character
; Hour and minute for WaitUntil command
until_time LABEL WORD
minute db 0 ; minute to wait for (0 - 60)
hour db 0 ; hour to wait for (0 - 24)
; Parameter block for DOS program-load function
parameter_block LABEL WORD
env_seg dw 0 ; segment of environment string
p_command_line LABEL dwORD ; pointer to command line
command_offset dw 0
command_segment dw 0
FCB1 LABEL dwORD ; FCB pointers
FCB1_O dw 0
FCB1_S dw 0
FCB2 LABEL dwORD
FCB2_O dw 0
FCB2_S dw 0
child_sp dw 0 ; child's SP
child_ss dw 0 ; child's SS
child_ip dw 0 ; child's IP
child_cs dw 0 ; child's CS
; Other information about the child process
child_psp dw 0 ; segment of child's PSP
child_size dw 0 ; size in paragraphs
; Video mode table
vseg_table LABEL BYTE ; Mode Type
db 0B8h ; 0: CGA 40x25 b/w
db 0B8h ; 1: CGA 40x25 16 colors
db 0B8h ; 2: CGA 80x25 b/w
db 0B8h ; 3: CGA 80x25 16 colors
db 0 ; 4: CGA graphics mode
db 0 ; 5: CGA graphics mode
db 0 ; 6: CGA graphics mode
db 0B0h ; 7: MDA 80x25 b/w
; Translation table: ASCII codes into keyboard scan codes
scan db 03, 30, 48, 46, 32, 18, 33, 34, 35, 23, 36, 37, 38, 50, 49, 24
; Nul ^A ^B ^C ^D ^E ^F ^G ^H ^I ^J ^K ^L ^M ^N ^O
db 25, 16, 19, 31, 20, 22, 47, 17, 45, 21, 44, 01, 26, 53, 27, 12
; ^P ^Q ^R ^S ^T ^U ^V ^W ^X ^Y ^Z Esc FS GS RS US
db 57, 02, 40, 04, 05, 06, 08, 40, 10, 11, 09, 13, 51, 12, 52, 53
; sp ! " # $ % & ' ( ) * + , - . /
db 11, 02, 03, 04, 05, 06, 07, 08, 09, 10, 39, 39, 51, 13, 52, 53
; 0 1 2 3 4 5 6 7 8 9 : ; < = > ?
db 03, 30, 48, 46, 32, 18, 33, 34, 35, 23, 36, 37, 38, 50, 49, 24
; @ A B C D E F G H I J K L M N O
db 25, 16, 19, 31, 20, 22, 47, 17, 45, 21, 44, 26, 43, 27, 07, 12
; P Q R S T U V W X Y Z [ \ ] ^ _
db 41, 30, 48, 46, 32, 18, 33, 34, 35, 23, 36, 37, 38, 50, 49, 24
; ` a b c d e f g h i j k l m n o
db 25, 16, 19, 31, 20, 22, 47, 17, 45, 21, 44, 26, 43, 27, 41, 14
; p q r s t u v w x y z { | } ~ Del
; Translation table for special keys
keyname_list LABEL BYTE
db 'ESC',0,'TAB',0,'ENTER',0
db 'F1',0,'F2',0,'F3',0,'F4',0,'F5',0,'F6',0,'F7',0,'F8',0,'F9',0
db 'F10',0
db 'HOME',0,'UP',0,'PGUP',0,'LEFT',0
db 'RIGHT',0,'END',0,'DOWN',0,'PGDN',0,'INS',0,'DEL',0
db 0
shiftname_list LABEL BYTE
db 'ALT',0,'CTRL',0,'SHIFT',0,0
shiftbits LABEL BYTE
db 08h, 04h, 02h
key_scans LABEL BYTE
db 1 ; Escape
db 15 ; Tab
db 28 ; Enter
db 59,60,61,62,63,64,65,66,67,68 ; F1 - F10
db 71 ; Home
db 72 ; Up Arrow
db 73 ; Page Up
db 75 ; Left Arrow
db 77 ; Right Arrow
db 79 ; End
db 80 ; Down Arrow
db 81 ; Page Down
db 82 ; Insert
db 83 ; Delete
; Shift tables
No_shift LABEL WORD
dw 0000h, 011Bh, 0231h, 0332h, 0433h, 0534h, 0635h, 0736h
dw 0837h, 0938h, 0A39h, 0B30h, 0C2Dh, 0D3Dh, 0E08h, 0F09h
dw 1071h, 1177h, 1265h, 1372h, 1474h, 1579h, 1675h, 1769h
dw 186Fh, 1970h, 1A5Bh, 1B5Dh, 1C0Dh, 0000h, 1E61h, 1F73h
dw 2064h, 2166h, 2267h, 2368h, 246Ah, 256Bh, 266Ch, 273Bh
dw 2827h, 2960h, 0000h, 2B5Ch, 2C7Ah, 2D78h, 2E63h, 2F76h
dw 3062h, 316Eh, 326Dh, 332Ch, 342Eh, 352Fh, 0000h, 372Ah
dw 0000h, 3920h, 0000h, 3B00h, 3C00h, 3D00h, 3E00h, 3F00h
dw 4000h, 4100h, 4200h, 4300h, 4400h, 0000h, 0000h, 4700h
dw 4800h, 4900h, 4A2Dh, 4B00h, 0000h, 4D00h, 4E2Bh, 4F00h
dw 5000h, 5100h, 5200h, 5300h
Shift_shift LABEL WORD
dw 0000h, 011Bh, 0221h, 0340h, 0423h, 0524h, 0625h, 075Eh
dw 0826h, 092Ah, 0A28h, 0B29h, 0C5Fh, 0D2Bh, 0E08h, 0F00h
dw 1051h, 1157h, 1245h, 1352h, 1454h, 1559h, 1655h, 1749h
dw 184Fh, 1950h, 1A7Bh, 1B7Dh, 1C0Dh, 0000h, 1E41h, 1F53h
dw 2044h, 2146h, 2247h, 2348h, 244Ah, 254Bh, 264Ch, 273Ah
dw 2822h, 297Eh, 0000h, 2B7Ch, 2C5Ah, 2D58h, 2E43h, 2F56h
dw 3042h, 314Eh, 324Dh, 333Ch, 343Eh, 353Fh, 0000h, 0000h
dw 0000h, 3920h, 0000h, 5400h, 5500h, 5600h, 5700h, 5800h
dw 5900h, 5A00h, 5B00h, 5C00h, 5D00h, 0000h, 0000h, 4737h
dw 4838h, 4939h, 4A2Dh, 4B34h, 4C35h, 4D36h, 4E2Bh, 4F31h
dw 5032h, 5133h, 5230h, 532Eh
Ctrl_shift LABEL WORD
dw 0000h, 011Bh, 0000h, 0300h, 0000h, 0000h, 0000h, 071Eh
dw 0000h, 0000h, 0000h, 0000h, 0C1Fh, 0000h, 0E7Fh, 0000h
dw 1011h, 1117h, 1205h, 1312h, 1414h, 1519h, 1615h, 1709h
dw 180Fh, 1910h, 1A1Bh, 1B1Dh, 1C0Ah, 0000h, 1E01h, 1F13h
dw 2004h, 2106h, 2207h, 2308h, 240Ah, 250Bh, 260Ch, 0000h
dw 0000h, 0000h, 0000h, 2B1Ch, 2C1Ah, 2D18h, 2E03h, 2F16h
dw 3002h, 310Eh, 320Dh, 0000h, 0000h, 0000h, 0000h, 3710h
dw 0000h, 3920h, 0000h, 5E00h, 5F00h, 6000h, 6100h, 6200h
dw 6300h, 6400h, 6500h, 6600h, 6700h, 0000h, 0000h, 7700h
dw 0000h, 8400h, 0000h, 7300h, 0000h, 7400h, 0000h, 7500h
dw 0000h, 7600h, 0000h, 0000h
Alt_shift LABEL WORD
dw 0000h, 0000h, 7800h, 7900h, 7A00h, 7B00h, 7C00h, 7D00h
dw 7E00h, 7F00h, 8000h, 8100h, 8200h, 8300h, 0000h, 0000h
dw 1000h, 1100h, 1200h, 1300h, 1400h, 1500h, 1600h, 1700h
dw 1800h, 1900h, 0000h, 0000h, 0000h, 0000h, 1E00h, 1F00h
dw 2000h, 2100h, 2200h, 2300h, 2400h, 2500h, 2600h, 0000h
dw 0000h, 0000h, 0000h, 0000h, 2C00h, 2D00h, 2E00h, 2F00h
dw 3000h, 3100h, 3200h, 0000h, 0000h, 0000h, 0000h, 0000h
dw 0000h, 3920h, 0000h, 6800h, 6900h, 6A00h, 6B00h, 6C00h
dw 6D00h, 6E00h, 6F00h, 7000h, 7100h, 0000h, 0000h, 0000h
dw 0000h, 0000h, 0000h, 0000h, 0000h, 0000h, 0000h, 0000h
dw 0000h, 0000h, 0000h, 0000h
;******************************************************************************
;* *
;* Interrupt-Intercept Procedures *
;* *
;******************************************************************************
; timer-interrupt intercept
timer_intercept proc far
pushf ; simulate another interrupt
call cs:i_timer ; to let timer do its thing
push ax
mov al,1
xchg al,cs:in_pan_flag ; check we're not already here
or al,al
jnz .tim4 ; exit immediately if so
mov ax,sp ; switch stacks
mov cs:callers_sp,sp
mov ax,ss
mov cs:callers_ss,ax
mov ax,cs
mov ss,ax
mov sp,OFFSET interrupt_stack
sti ; allow interrupts
push bx ; save all registers
push cx
push dx
push si
push di
push ds
push es
push bp
mov ax,cs ; set DS and ES to PAN segment
mov ds,ax
mov es,ax
cld
mov ax,time_out ; AX = number of ticks to timeout
test ax,ax ; are we in a waiting period?
jz .tim2 ; if no waiting
dec time_out ; else count down the ticks
jnz .tim3 ; if more to go
call [recall_address] ; recall processor for current command
jmp SHORT .tim3
.tim2: call interpret ; process a new command
cmp time_out,0 ; check number of ticks to timeout
je .tim2 ; if no wait then do another
.tim3: pop bp ; restore state
pop es
pop ds
pop di
pop si
pop dx
pop cx
pop bx
cli ; turn off interrupts
mov ax,cs:callers_sp ; restore the interruptee's stack
mov sp,ax
mov ax,cs:callers_ss
mov ss,ax
mov cs:in_pan_flag,0 ; and reset in-Pan flag
.tim4: pop ax
iret
timer_intercept endp
; Keyboard interrupt intercept. Every time a keyboard interrupt
; occurs we mess with the pointers to make it seem that the BIOS
; keyboard-input queue is full. This allows a Ctrl-Alt-Del to
; take effect but for all normal keypresses the user will get a
; beep.
keyboard_intercept proc far
push ax
push ds
mov ds,cs:kbb_segment ; DS = keyboard-buffer segment
mov ax,ds:[KBB_TAIL] ; get tail
inc ax ; bump tail pointer
inc ax
cmp ax,ds:[KBB_END]
jne .ki1
mov ax,ds:[KBB_START] ; if wrapped around
.ki1: xchg ax,ds:[KBB_HEAD] ; make it look like there's no room
pushf ; fake interrupt to real handler
call cs:i_keyboard
xchg ax,ds:[KBB_HEAD] ; replace "real" head of queue
pop ds
pop ax
iret ; disconnects the keyboard
keyboard_intercept endp
; BIOS-keyboard interrupt intercept
BIOS_kb_intercept proc far
pushf
cmp ah,01h ; Function 0 or 1?
ja .kbi2 ; no, let BIOS handle it
sti ; ensure interrupts can happen
je .kbi1
; Handle function 00h: Read Character from Keyboard. If PAN has locked the
; keyboard then we delay the process until the lock is released. If PAN has
; not locked the keyboard then we check if a character is available; if it is
; then we let the BIOS complete the request, else keep waiting in case PAN
; locks the keyboard.
.kbi0: test cs:keyboard_feed,0FFh ; has PAN reserved the keyboard?
jnz .kbi0
mov ah,01h ; BIOS Get Keyboard Status
pushf
call cs:[i_BIOS_kb]
jz .kbi0
mov ah,00h
jmp SHORT .kbi2
; Handle function 01h: Get Keyboard Status. If PAN has locked the keyboard
; then we return a no-character-waiting indication to the process. If PAN
; has not locked the keyboard then we let the BIOS handle the request.
.kbi1: test cs:keyboard_feed,0FFh ; has PAN reserved the keyboard?
jz .kbi2 ; no, go to BIOS
popf
xor ax,ax ; yes, return with no input indication
retf 2
.kbi2: popf
jmp cs:[i_BIOS_kb]
BIOS_kb_intercept endp
; Ctrl-Break intercept
ctrl_break_intercept proc far
iret
ctrl_break_intercept endp
;******************************************************************************
;* *
;* Entry Code *
;* *
;******************************************************************************
assume ds:code
main proc near
cld
mov sp,100h ; set internal stack
mov dx,OFFSET initmsg ; announce program
mov ah,9h
int 21h
call c_Mode ; determine video mode
push es
mov ax,3516h ; get interrupt vector for BIOS kb
int 21h ; ES:BX -> BIOS kb service
mov x_bk_offset,bx ; save this for internal use
mov ax,es
mov x_bk_segment,ax
pop es
call get_script ; load the command file
jc .mai3
mov bx,OFFSET script_buffer ; calculate paragraphs used
add bx,ax ; AX = size of script as loaded
add bx,15 ; round up to a paragraph boundary
mov cx,4
shr bx,cl ; convert to paragraphs
mov ah,4Ah ; DOS modify allocated memory blocks
int 21h
call resolve_jumps ; prepare the script
jc .mai3 ; if an error was detected
mov ax,OFFSET script_buffer ; set command pointer
mov command_ptr,ax
.mai1: call interpret ; perform the first/next command
.mai2: xor cx,cx
xchg cx,time_out ; CX = timeout
test cx,cx ; did last command set a timeout?
jz .mai1 ; if not continue processing
call delay ; else delay for the requisite period
call [recall_address] ; then call the completion code
jmp SHORT .mai2 ; which can timeout again
.mai3: mov ah,9h ; get here with SI -> error message
int 21h ; have DOS display it
.mai4: jmp terminate ; die
main endp
;******************************************************************************
;* *
;* Primary PAN Command Interpreter *
;* *
;******************************************************************************
interpret proc near
mov si,command_ptr ; SI -> next command
xor ax,ax
lodsb ; AX = command length
test al,al ; zero-length command => end of script
jz .int3
add command_ptr,ax ; update the command pointer
mov current_command,si ; save pointer to current command
lodsb ; AX = command index
mul command_entry_size ; convert to table offset
mov bx,ax ; BX = entry offset
xor ax,ax
or al,if_condition
jnz .int1 ; if processing off
; call the command processor with AX = 0
call WORD PTR [command_table+PC_PROC+bx]
mov time_out,ax ; store time-out counter
mov recall_address,bx ; and recall address if valid
ret
.int1: xor ax,ax ; get AX = command type
mov al,BYTE PTR [command_table+PC_TYPE+bx]
mov bx,ax ; and call corresponding proc
call [n_table+bx]
.int2: ret
.int3: jmp c_Quit ; Quit on end of script
interpret endp
;******************************************************************************
;* *
;* Procedures for performing PAN commands *
;* *
;******************************************************************************
; Break On/Off
c_Break proc near
mov bx,OFFSET on_off ; BX -> "ON/OFF"
call match_key ; check the argument
jne .cb1 ; if not "ON" nor "OFF"
mov break_condition,al ; else index sets the break condition
xor ax,ax ; this command complete
ret
.cb1: mov si,OFFSET .cbmsg ; "Break should have argument On or Off"
jmp command_error
.cbmsg db 'Break should have argument "On" or "Off"',0
c_Break endp
; Else - if Else belongs to the last If processed then reverse the
; current if condition
c_Else proc near
mov al,if_nest_level ; is this else effective?
cmp al,if_effect_level
ja .cel1 ; ignore if not
not if_condition ; switch the condition marker
.cel1: xor ax,ax ; this command completed
ret
c_Else endp
; Cursor <row> <column> - move the cursor to the given position.
c_Cursor proc near
call get_screen_position ; decode row and column
mov ah,02h ; BIOS Set Cursor Position
xor bx,bx ; assume page 0
mov dx,screen_position ; DH = row, DL = column
int 10h
xor ax,ax ; that does it
ret
c_Cursor endp
; EndIf - terminate an IF clause
c_EndIf proc near
cmp if_nest_level,0 ; is EndIf appropriate?
jz .cen1 ; ignore if not (should be impossible)
mov al,if_nest_level ; if this EndIf effective?
dec if_nest_level ; count out one level
cmp al,if_effect_level
jne .cen1 ; if not there is no more to do
dec if_effect_level
mov if_condition,0 ; process!
.cen1: xor ax,ax ; all done
ret
c_EndIf endp
; Flush - flush keypress buffer
c_Flush proc near
.cf1: mov ah,01h ; check for keyboard input
pushf ; by emulating interrupt to the BIOS
call [i_BIOS_kb] ; int 16h
jz .cf2 ; if no input
xor ax,ax ; else read that input
pushf
call [i_BIOS_kb] ; int 16h
jmp SHORT .cf1 ; keep checking until there is none
.cf2: xor ax,ax ; no continuation
ret
c_Flush endp
; GetKey - input a keypress
c_GetKey proc near
cmp pan_state,PS_RUNNING ; target program in action?
je .gk3 ; yes, get a keypress by stealth
mov ah,00h ; else just use BIOS service
int 16h
mov keypress,ax ; save the codes
cmp break_condition,0 ; break mode on?
jz .gk1 ; no, don't handle aborts specially
cmp ax,2E03h ; Control-C?
je .gk2 ; quit if so
.gk1: xor ax,ax
ret
.gk2: jmp c_Quit
.gk3: mov ax,1 ; check on every tick
mov bx,OFFSET .gk4 ; come back at label .gk4
inc keyboard_feed ; lock the keyboard
ret
.gk4: mov ah,01h ; check for keyboard input
pushf
call [i_BIOS_kb] ; int 16h
jz .gk5 ; if none
xor ax,ax ; read that input
pushf
call [i_BIOS_kb] ; int 16h
mov keypress,ax ; save it
dec keyboard_feed ; release the keyboard
ret
.gk5: inc time_out ; continue waiting
ret
c_GetKey endp
; Go - initiate execution of a loaded program
c_Go proc near
cmp pan_state,PS_LOADED ; check that state is correct
je .go2 ; if okay...
mov si,OFFSET .gomsg2 ; "Program already running"
jg .go1 ; error if Go done already
mov si,OFFSET .gomsg1 ; "No program loaded"
.go1: jmp command_error
.gomsg1 db 'No program loaded',0
.gomsg2 db 'Program already running',0
; Copy command line to child's PSP
.go2: call normalize ; copy command line
mov es,child_psp ; ES = PSP of child
mov di,81h ; ES:DI -> command-line area
mov al,' ' ; force a blank at the start
cmp [si],al
je .go3
stosb ; good command lines start this way
.go3: rep movsb ; copy command line
dec di ; and append a carriage return
mov BYTE PTR es:[di],CR
mov ax,di ; calculate length of command line
sub al,81h
mov es:[80h],al ; and prepend length to the line
; Set up default FCBs just in case
push ds
mov ax,2901h ; DOS Parse filename
mov ds,child_psp
mov si,81h ; DS:SI -> command line to parse
mov di,92 ; ES:DI -> place for 1st FCB
int 21h
mov cx,ax ; save drive valid flag
mov ax,2901h ; DOS Parse filename
mov di,108 ; ES:DI -> place for 2nd FCB
int 21h
pop ds
mov in_pan_flag,1 ; make intercepts ineffective
call set_traps ; set traps
mov pan_state,PS_RUNNING ; set state to running
jmp run_it ; and transfer control
c_Go endp
; IfKey "keylist" - check if last captured keystroke is in the given list.
c_IfKey proc near
call normalize ; copy and fix the string
.ifk1: call translate ; get AX = key code
jc iffalse ; if no more keys in string
cmp ax,keypress ; is it what we captured?
je iftrue
jne .ifk1
c_IfKey endp
; IfLoad "program_name" - attempt to load the specified program and
; set condition code according to result
c_IfLoad proc near
cmp pan_state,PS_INITIAL ; check that state is suitable
jne .ifl1 ; if a program has already been loaded
call loader ; try the load
jc iffalse ; if load failed
jnc iftrue
.ifl1: mov si,OFFSET .loadm ; complain, complain, complain
jmp command_error
.loadm db 'A program is already loaded',0
c_IfLoad endp
; IfScreen <row> <column> "string" - check if "string" appears on screen
c_IfScreen proc near
call get_screen_position ; decode row and column
call skip_whitespace ; find the "string"
call normalize ; copy and normalize the string
call check_screen ; check if it's there
jns iftrue ; if the string is there
js iffalse ; if it's not
c_IfScreen endp
; Set If condition false
iffalse proc near
not if_condition ; inhibit processing
; and fall through
iffalse endp
; Set If condition true
iftrue proc near
inc if_nest_level ; count up one more If level
inc if_effect_level ; and active level
xor ax,ax ; and we're done
ret
iftrue endp
; Jump label - transfer control to command following the named label.
c_Jump proc near
lodsw ; AX -> destination
mov command_ptr,ax ; set new command pointer
xor ax,ax ; done
ret
c_Jump endp
; Key "string" - make it appear as though "string" were typed.
c_Key proc near
call copy_string ; copy the string
mov kiq_first,si ; point to first character
mov ax,1 ; continue on next tick
mov bx,OFFSET stuff_keys ; at proc stuff_keys
ret
c_Key endp
; Label name
c_Label proc near
ret ; no operation
c_Label endp
; Load "program_name"
c_Load proc near
cmp pan_state,PS_INITIAL ; check that state is suitable
jne .ifl1 ; if a program has already been loaded
call loader ; attempt a load
jc bad_load ; if load failed
.cl1: xor ax,ax ; load successful, continue
ret
bad_load:
mov dx,OFFSET .clA ; "Cannot find target program"
cmp al,3 ; file or path not found?
jle .bl1
mov dx,OFFSET .clB ; "Insufficient memory to load"
cmp al,8
je .bl1
mov dx,OFFSET .clC ; "Cannot load target program"
.bl1: mov ah,9h
int 21h
call ttyz ; display filename
jmp c_Quit
.clA db 'PAN Error: Cannot find target program: $'
.clB db 'PAN Error: Insufficient memory to load program: $'
.clC db 'PAN Error: Cannot load target program: $'
c_Load endp
; Lock - disconnect keyboard from application
c_Lock proc near
cmp keyboard_state,0 ; is keyboard already locked?
jne .loc1 ; if so this is a no-op
inc keyboard_state ; else set state to locked
mov dx,OFFSET keyboard_intercept ; replace keyboard interrupt
mov al,9h
mov bx,OFFSET i_keyboard
call set_vector
mov dx,OFFSET ctrl_break_intercept ; replace Ctrl-Break interrupt
mov al,23h
mov bx,OFFSET i_ctrl_break
call set_vector
.loc1: xor ax,ax
ret
c_Lock endp
; Mode - force reassessment of current video mode
c_Mode proc near
mov ah,0Fh ; BIOS Get Video Mode
int 10h ; returns AH = # columns, AL = mode,
; and BH = active page
cmp al,7 ; we only do text modes (0,1,2,3 and 7)
ja .cm1
mov screen_columns,ah ; save number of columns on screen
xor ah,ah
mov bx,ax ; BX = mode
xor ax,ax
mov ah,[vseg_table+bx] ; AX = video buffer segment
mov video_segment,ax
ret
.cm1: mov video_segment,0 ; video mode that PAN does not handle
ret
c_Mode endp
; Output <string> - send a string to standard output
c_Output proc near
cmp pan_state,PS_RUNNING ; is state suitable for DOS call?
jae .co2 ; ignore the command if it's not
call normalize ; straighten up the string
.co1: lodsb ; AL = next character
test al,al
jz .co2 ; at end of string
mov ah,02h ; DOS Display Output
mov dl,al ; DL = character
int 21h
jmp SHORT .co1 ; loop for all characters
.co2: xor ax,ax ; and we're done
ret
c_Output endp
; Pause <n> ticks/seconds/minutes - delay for a given period
c_Pause proc near
call decode_decimal ; decode decimal count
test ah,ah ; 0 - 255 allowed
jnz .cp2 ; if out of bounds
mov cx,ax ; CX = number
call skip_whitespace ; skip to units
jz .cps ; if no units then use seconds
call isletter ; check that units starts with a letter
jc .cp2 ; give error if it doesn't
cmp al,'T' ; ticks?
je .cpt
cmp al,'S' ; seconds?
je .cps
cmp al,'M' ; minutes?
jne .cp2
cmp cl,60 ; 60 minutes is the max
jg .cp2
mov ax,1092 ; AX = number of ticks in a minute
mul cx ; get AX = number of seconds
jmp SHORT .cp0
.cps: mov al,18 ; multiple by 18.25 to approximate 18.2
mul cl
shr cx,1
shr cx,1
add ax,cx
jmp SHORT .cp0
.cpt: mov ax,cx ; AX = tick count
.cp0: mov bx,OFFSET .cp1 ; return with AX = timeout, recall here
.cp1: ret
.cp2: mov si,OFFSET .cpmsg ; 'Pause 1-255 ticks, 1-255 seconds or 1-60 minutes'
jmp command_error
five db 5
.cpmsg db 'Pause 1-255 ticks, 1-255 seconds or 1-60 minutes',0
c_Pause endp
; Quit
c_Quit proc near
call unset_traps ; make sure no traps are left set
call c_Unlock ; and that the keyboard is unlocked
cmp pan_state,PS_LOADED ; got a program loaded and ready to go?
je .cq2 ; if so we must get rid of it
cmp pan_state,PS_RUNNING ; running a child program?
je .cq1 ; if so
jmp terminate ; otherwise we can exit gracefully
.cq1: mov pan_state,PS_QUIT ; quit when target program quits
mov ax,1
ret
.cq2: mov child_cs,cs ; fix things so child will die at birth
mov ax,OFFSET terminate
mov child_ip,ax
mov pan_state,PS_QUIT ; quit when target program quits
jmp run_it ; then go run it
c_Quit endp
; Screen <row> <column> "string" - write a string directly onto the
; screen.
c_Screen proc near
call get_screen_position ; decode row and column
call skip_whitespace ; skip to "string"
call normalize ; copy and fix the string
mov dx,screen_position ; DX = row + column
mov bl,va ; BL = video attribute
call display_string ; display the string
xor ax,ax ; no continuation
ret
c_Screen endp
; SetIf - set the if nesting level after a Label.
;
; Note: This is an internal command that is inserted automatically
; following each Label command. The effect is to make Ifs and
; EndIfs work like proper bracket operators. It allows Jumps
; to be made out of If/EndIf blocks. It also, er, allows Jumps
; to be made into If/EndIf blocks!!
c_SetIf proc near
lodsb ; AL = current level
mov if_nest_level,al ; make that the nesting level
mov if_effect_level,al ; and the effective level
xor ax,ax ; that's it
ret
c_SetIf endp
; TypeRate <ticks> - set a rate for emulating typing (in ticks)
c_TypeRate proc near
call decode_decimal ; decode decimal tick count
mov type_rate,ax ; store the type rate
xor ax,ax ; no continuation
ret
c_TypeRate endp
; Unlock - connect keyboard to application
c_Unlock proc near
cmp keyboard_state,1 ; is keyboard locked?
jne .unl1 ; if not this is a no-op
dec keyboard_state ; set state to unlocked
mov al,9h ; remove keyboard intercept
mov bx,OFFSET i_keyboard
call restore_vector
mov al,23h ; reset Control-Break vector
mov bx,OFFSET i_ctrl_break
call restore_vector
.unl1: xor ax,ax
ret
c_Unlock endp
; Video <attribute> - set video attribute.
c_Video proc near
call decode_hex ; decode attribute into AL
mov va,al ; and store it away
xor ax,ax ; no continuation
ret
c_Video endp
; WaitChild - wait for child to die.
c_WaitChild proc near
cmp pan_state,PS_RUNNING ; only valid in running state
jne .wc2 ; error in any other state
mov pan_state,PS_OBIT ; change state to PS_OBIT
call unset_traps ; no longer need these
.wc1: mov ax,1 ; to stop command processing
ret
.wc2: mov si,OFFSET .wcA ; what is PAN expected to do?
jmp command_error
.wcA db 'No program running to wait for',0
c_WaitChild endp
; WaitScreen <row> <column> "string" - wait for the given string to
; appear on screen.
c_WaitScreen proc near
call get_screen_position ; decode row and column
call skip_whitespace ; skip to the "string"
call normalize ; copy and normalize the string
mov ax,1 ; check on next tick
mov bx,OFFSET .ws1 ; at label .ws1
ret
.ws1: mov si,OFFSET line_buffer ; SI -> string to be matched
call check_screen ; see if it's there
jnc .ws4 ; if the string has appeared
.ws3: mov time_out,3 ; try again in 3 more ticks' time
.ws4: ret
c_WaitScreen endp
; WaitUntil <HH:MM> - wait until a given time of day
c_WaitUntil proc near
cmp pan_state,PS_RUNNING ; cannot do this in background mode
jae .wu5
call decode_decimal ; decode decimal tick count
mov hour,al ; save hour (0-24)
inc si
call decode_decimal ; decode decimal tick count
mov minute,al ; save minute (0-60)
mov ax,18 ; check every second
mov bx,OFFSET .wu1 ; below
ret
.wu1: mov ah,2Ch ; DOS Get Time
int 21h
cmp cx,until_time ; has the due time come around?
jne .wu3 ; no, keep waiting
.wu2: ret ; yes, do next command
.wu3: mov ah,01h ; check for keyboard input
pushf
call [i_BIOS_kb] ; int 16h
jz .wu4 ; if none
xor ax,ax ; read that input
pushf
call [i_BIOS_kb] ; int 16h
cmp al,1Bh ; Escape?
jne .wu4 ; ignore anything but
cmp pan_state,PS_RUNNING ; running a program?
je .wu2 ; yes, skip to next command
jmp terminate ; no, terminate the program
.wu4: mov time_out,18 ; wait another second
ret
.wu5: mov si,OFFSET .wuA ; "Command not valid during background operation"
jmp command_error
.wuA db 'Command not valid during background operation',0
c_WaitUntil endp
; Wipe - clear the screen
c_Wipe proc near
mov ah,0Fh ; BIOS get video mode
int 10h ; returns AL = display mode
mov ah,00h ; BIOS set video mode
int 10h ; which incidentally clears the screen
xor ax,ax ; no continuation
ret
c_Wipe endp
; Procedures for handling commands while command-processing is inhibited.
; Process any kind of IF command when processing suspended
n_If proc near
inc if_nest_level ; one level of If/EndIf deeper
ret
n_If endp
; Regular commands are no-ops
n_Nop proc near
ret
n_Nop endp
;******************************************************************************
;* *
;* Miscellaneous procedures *
;* *
;******************************************************************************
; check_screen - checks if a given string appears at a given screen position
;
; Called with:
; SI -> string to be sought
; 'screen_position' holding the row and column
;
; Returns:
; CF = 0 if string is found
; CF = 1 otherwise
check_screen proc near
push es
mov dx,screen_position ; set PAN screen position
call set_video_address
.chs1: cmp BYTE PTR [si],0 ; check the next byte
je .chs3 ; if null we matched the whole string!
mov ax,es:[di] ; AH = attribute, AL = character code
cmp [si],al ; is character the one we want?
jne .chs2 ; no, so match fails...
inc di ; yes, check next
inc di
inc si
jmp SHORT .chs1
.chs2: stc ; return CF set for failure
.chs3: pop es
ret ; returns CF = 0 if match else CF = 1
check_screen endp
; command_error - spits out error information and quits.
;
; Called with:
; SI -> diagnostic (null terminated string)
command_error proc near ; SI -> diagnostic message
push si ; save diagnostic pointer
cmp pan_state,PS_LOADED ; check the state
jbe .ce1 ; if PAN is in control
cli ; else turn off interrupts
; Prepare screen for messages
.ce1: mov ah,0Fh ; BIOS get video mode
int 10h ; returns AL = display mode
; convert to a suitable mode
xor bx,bx
mov bl,al
mov al,[bomb_Mode+bx] ; AL = safest text mode
mov ah,00h ; BIOS set video mode
int 10h ; which incidentally clears the screen
mov si,OFFSET ferrmsg ; "Fatal error in PAN Command: "
call ttyz
call reconstruct_command ; recreate text of command
call ttyz ; and display it
mov si,OFFSET crlfz
call ttyz
pop si ; display the specific diagnostic
call ttyz
cmp pan_state,PS_LOADED ; check the state
ja .ce2 ; if PAN is not in control
jmp c_Quit ; then get out quick
.ce2: mov si,OFFSET bomb_msg2 ; else wait for confirmation
call ttyz
xor ax,ax ; wait for input
pushf
call [i_BIOS_kb] ; int 16h
xor ax,ax ; do a warm boot
mov ds,ax
mov ax,1234h
mov ds:[472h],ax
db 0EAh ; JMP FFFF:0000
dw 0000h, 0FFFFh
bomb_Mode db 0,1,2,3,0,0,0,7,0,0, 0,11,12, 2, 2, 2, 2, 2, 7, 2
; 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19
bomb_msg2 db CR,LF,'Press the [Space Bar] to reboot.',0
ferrmsg db 'Fatal error in PAN command:',CR,LF,0
command_error endp
; compare_strings
;
; Called with:
; SI and DI -> strings to be compared
; CX = length
;
; Returns:
; CX, SI and DI unchanged
; flags: see CMPS instruction
compare_strings proc near
push si
push di
push cx
repe cmpsb
pop cx
pop di
pop si
ret
compare_strings endp
; Copy a null-terminated string.
;
; Called with:
; SI -> source string (null terminated)
; DI -> destination
;
; Returns:
; SI = garbage
; DI -> null at end of the copy
copyz proc near
.cz1: lodsb ; copy each byte including the null
stosb
test al,al
jnz .cz1 ; continue until null
dec di ; DI -> null at end of copied string
ret
copyz endp
; Copy a delimited terminated string to 'line_buffer'.
;
; Called with:
; SI -> "string"
;
; Returns:
; SI -> copy
; DI = garbage
copy_string proc near
mov di,OFFSET line_buffer ; DI -> standard destination
push di
lodsb ; AL = delimiter
mov ah,al ; keep in AH
.cs1: lodsb ; AL = next character
test al,al ; allow missing closing delimiter
jz .cs3 ; if end of string
cmp al,ah ; delimiter?
jz .cs3
stosb
jmp SHORT .cs1
.cs3: xor ax,ax ; store null terminator
stosb
pop si ; SI -> line_buffer
ret ; returns SI -> copied string
copy_string endp
; decode a decimal number
;
; Called with:
; SI -> numeric string
;
; Returns:
; SI -> first non-numeric character in string
; AX = decoded value
decode_decimal proc near
xor bx,bx ; decode value into bx
mov cx,10 ; CL = 10, keep sign indication in CH
cmp BYTE PTR [si],'+' ; initial + or - is allowed
je .dec0
cmp BYTE PTR [si],'-'
jne .dec1
inc ch
.dec0: inc si ; push SI past sign
.dec1: lodsb ; AL = next character
sub al,'0' ; check if it's a digit
jl .dec2
cmp al,9
jg .dec2
xchg ax,bx ; AX = cumulative total
mul cl ; multiply by ten
add bx,ax ; and add in the new digit
jmp .dec1
.dec2: mov ax,bx ; AX = decoded value for return
test ch,ch ; + or -
jz .dec3 ; if +
neg ax ; if - then negate it
.dec3: dec si ; back up SI to first non-digit
ret
decode_decimal endp
; decode a hex number
;
; Called with:
; SI -> numeric string
;
; Returns:
; SI -> first non-numeric character in string
; AX = decoded value
decode_hex proc near
xor bx,bx ; put decoded value in bx
.hex1: lodsb ; AL = next character
cmp al,'0' ; check if it's a hexit
jl .hex2
cmp al,'9'
jg .hex2
sub al,'0'
.hex0: mov cl,4 ; multiply result so far by 16
shl bx,cl
add bx,ax ; and add in the new hexit
jmp .hex1
.hex2: call isletter
jc .hex3 ; if not a letter
cmp al,'G'
jae .hex3
sub al,'A'-10
jmp .hex0
.hex3: mov ax,bx ; set result in AX
dec si ; point SI to terminator
ret
decode_hex endp
; delay - pause for a given count of clock ticks.
;
; Called with:
; CX = number of 18.2-to-a-second ticks
CLOCK = 46Ch ; low-memory timer word
delay proc near
push es ; get ES = 0
xor ax,ax
mov es,ax
mov ax,es:[CLOCK] ; AX = current clock value
.del1: cmp ax,es:[CLOCK] ; count down changes in the clock
je .del1
mov ax,es:[CLOCK]
loop .del1
pop es
ret
delay endp
; display_string - display a null-terminated string on the screen.
;
; Called with:
; DX = screen position
; BL = video attribute
; SI -> string
display_string proc near ; DX = screen position, BL = video attribute
push es
call set_video_address ; get ES:DI -> video buffer
mov ah,bl ; AH = attribute
.ds1: lodsb ; AL = next character from string
test al,al ; ends at a null
jz .ds2
stosw ; pop into video memory
jmp SHORT .ds1
.ds2: pop es
ret
display_string endp
; get_screen_position - decode a row-column spec. Note that the row and
; column numbers are counted from zero, and are
; deliberately not checked for validity.
; Called with:
; SI -> "<row> <column>"
;
; Stores the result in 'screen_position'.
get_screen_position proc near
call decode_decimal ; decode row number
mov n_row,al
call skip_whitespace ; skip separator
call decode_decimal ; decode column number
mov n_col,al
ret
get_screen_position endp
; get_script - determines the script-file name from the command-line
; argument, loads and preprocesses the file.
;
; On return:
; AX = number of bytes read
get_script proc near
mov si,80h ; SI -> command line
xor ax,ax ; first character holds the lebgth
lodsb
mov bx,ax ; AX = BX = character count
mov [si+bx],ah ; replace terminator with null
call skip_whitespace ; skip any spaces
mov dx,OFFSET .gsB ; "ERROR: No script file specified"
jz .gs6 ; if no filename given
mov dx,si ; DX -> filename
xor ax,ax
.gs1: lodsb ; see if name includes an extension
cmp al,'.' ; that is a period
jne .gs2
mov ah,al ; note period in AH
.gs2: cmp al,' ' ; take any control character as the end
ja .gs1 ; this is chancy but...
cmp ah,'.'
je .gs3 ; if an extension was given
mov di,si ; else append the default
dec di
mov si,OFFSET pan_extension
mov cx,5 ; which is 5 characters long with null
rep movsb
.gs3: mov ax,3D00h ; open the command file
int 21h
mov dx,OFFSET .gsC
jc .gs7 ; if open returned an error
mov file_handle,ax ; else save the handle
call load_script ; load the script from the file
jc .gs7 ; if there was something wrong with it
mov ah,3Eh ; DOS close file
mov bx,file_handle
int 21h
cmp if_nest_level,0
jnz .gs4 ; if Ifs and EndIfs don't match
mov ax,di ; return size of script
sub ax,OFFSET script_buffer
clc
ret
.gs4: mov dx,OFFSET .gsD ; complain
.gs6: stc
.gs7: ret
.gsB db 'PAN Error: No script file specified$'
.gsC db 'PAN Error: Cannot find script file$'
.gsD db "PAN Error: Unbalanced Ifs and EndIfs$"
get_script endp
; is_digit - checks if character is an ASCII-coded digit
;
; Called with:
; AL = character
;
; Returns:
; CF = 0 if character is a digit ('0' - '9')
; CF = 1 otherwise
is_digit proc near
cmp al,'0' ; is it a numeric ASCII code?
jb .id1
cmp al,'9'
ja .id1
clc
ret
.id1: stc
ret
is_digit endp
; isletter - check and fold a letter
;
; Called with:
; al = ASCII code
;
; Returns:
; CF = 0 if AL contains a letter
; 1 otherwise
; AL = ASCII code, folded to uppercase if letter
isletter proc near
cmp al,'A'
jb .let1
cmp al,'Z'
jbe .let2
cmp al,'a'
jb .let1
cmp al,'z'
ja .let1
.let2: and al,0DFh ; fold
ret
.let1: stc
ret
isletter endp
; loader - attempt to load a target program given a filename.
;
; Called with:
; SI -> program filename
loader proc near
call normalize ; copy filename and arguments
mov ax,4B01h ; DOS Load Program and Return function
mov bx,OFFSET parameter_block ; BX -> parameter block
mov dx,si ; DX -> filename
int 21h ; returns in child context
jc .load1 ; unless load attempt failed
mov child_size,bx ; save size of program
mov ah,51h ; DOS get PSP address
int 21h ; returns BX = segment of PSP
mov child_psp,bx ; save that
mov al,50h ; DOS set PSP address
mov bx,cs ; set process back to us
int 21h
mov pan_state,PS_LOADED ; set state to PS_LOADED
clc
.load1: ret
loader endp
; load_script - loads the script from a given opened file.
;
; Called with:
; 'file_handle' containing the handle of the file.
;
; Returns:
; CF = 0 if script was loaded succesfully
; CF = 1 if an error occurred
load_script proc near
mov di,OFFSET script_buffer
.ls1: mov bx,file_handle
call read_line ; read one line = one command
jc .ls3 ; on EOF
call skip_whitespace ; skip any initial blanks
test al,al ; blank line?
jz .ls1 ; yes, ignore it
cmp al,'*' ; comment line?
je .ls1 ; yes, ignore it
mov bx,OFFSET command_keys ; identify the command
call match_key ; returns AL = command index if valid
jnz .ls4 ; if it's invalid
push di ; save pointer to start of command
inc di ; reserve a byte for command length
stosb ; store command index
call skip_whitespace ; skip any blanks after command
.ls2: lodsb ; copy the rest of the line
stosb
test al,al ; including the null terminator
jnz .ls2
pop bx ; BX -> start of command
mov ax,di ; AX -> end of command
sub ax,bx ; AX = length of command
mov [bx],al ; store that
; Do If/EndIf checking
xor ax,ax
inc bx
mov al,[bx] ; AX = command index
push ax
mul command_entry_size
mov bx,ax ; BX = offset of command table entry
xor ax,ax ; get AX = the command type
mov al,BYTE PTR [command_table+PC_TYPE+bx]
mov bx,ax
pop ax ; call preprocessor with AX = index
call [preprocessing_table+bx]
jnc .ls1 ; if no error
ret ; else return with CF set
.ls3: xor ax,ax ; zero-length command at end of script
stosw
ret
.ls4: call ttyz ; display the offending line
mov dx,OFFSET .lsA ; DX -> "Invalid command"
stc
ret
.lsA db CR,LF,'PAN Error: Invalid command.$'
load_script endp
; Procedures for preprocessing commands:
pp_regular proc near ; for regular commands there is nothing to do
cmp al,LABEL_INDEX ; unless this was a label command
jne .ppr1
mov al,3 ; store length for a SetIf
stosb
mov al,SETIF_INDEX ; insert a SetIf
stosb
mov al,if_nest_level
stosb
.ppr1: clc
ret
pp_regular endp
pp_If proc near ; for Ifs increment the nest level
inc if_nest_level
clc
ret
pp_If endp
pp_Else proc near ; for Else ensure it's in an If block
cmp if_nest_level,0
jnz .ppe1
mov dx,OFFSET .ppeA ; complain about misplaced Else
stc
.ppe1: ret
.ppeA db "PAN Error: 'Else' command not in If/EndIf clause$"
pp_Else endp
pp_EndIf proc near ; For EndIf decrement the nest level
cmp if_nest_level,0
jnz .ppf1
mov dx,OFFSET .ppfA ; complain about dangling EndIf
stc
ret
.ppf1: dec if_nest_level
clc
ret
.ppfA db "Error: EndIf found with no matching If$"
pp_EndIf endp
; match_key - match a string to a set of keys. The comparison is for
; letters only and is case insensitive.
;
; Called with:
; BX -> list of keys
; SI -> string to be matched
;
; Returns:
; If match made: ZR = 1 and AX = index of the key
; Else: ZR = 0
match_key proc near
push di
call skip_whitespace ; skip any leading blanks
mov di,si ; SI, DI -> first non-white char
xor cx,cx ; count keys in CX
.mat1: mov si,di ; SI -> target of match
.mat2: mov ah,[bx] ; AH = character to compare against
inc bx ; bump the pointer
test ah,ah ; check for end of key
jz .mat4 ; we got a match
lodsb ; AL = next character of string
cmp al,' ' ; match up to blank or control char
jbe .mat3
cmp al,ah ; do the real comparison
je .mat2 ; if they match then keep trying
xor al,20h ; else switch case of string char
cmp al,ah ; and compare that way
je .mat2
.mat3: cmp BYTE PTR [bx],0 ; push BX to end of current key
pushf
inc bx
popf
jnz .mat3
inc cx ; increment key counter
cmp BYTE PTR [bx],0 ; have we tried all keys?
jnz .mat1 ; no, try next
.mat35: mov si,di ; no match, return SI as it was
inc cx ; just to ensure that ZR = 0
pop di
ret ; no match: return ZR = 0, SI as on entry
.mat4: lodsb ; AL = next character of string
cmp al,' ' ; it should be blank or control char
ja .mat35
dec si
xor ax,ax ; set ZR
mov ax,cx ; AX = key number
pop di
ret ; match: return ZR = 1, AX = key number
match_key endp ; and SI -> character past key
; normalize - normalize translates a string containing control characters
; in the form '^X' while copying it to line_buffer.
;
; Called with:
; SI -> delimited string
;
; Returns:
; SI -> normalized string in 'line_buffer'
; DI -> end of normalized string
; CX = length
normalize proc near
mov di,OFFSET line_buffer
push di
xor ax,ax
lodsb ; AL = delimiter
or ah,al ; keep in AH
jz .nor3 ; if no argument
.nor1: lodsb ; AL = next character
test al,al
jz .nor3 ; if end of input
cmp al,ah ; end of delimited string?
je .nor3
cmp al,' '
jb .nor1 ; ignore "real" control characters
cmp al,'^'
jne .nor2
lodsb
cmp al,'^' ; ^^ means ^
je .nor2
and al,1Fh ; make a control
.nor2: stosb ; and store into string
jmp SHORT .nor1
.nor3: xor ax,ax ; store null terminator
stosb
pop si ; SI -> line_buffer
mov cx,di ; calculate new length
sub cx,si
ret ; returns SI -> normalized string, CX = length
; DI -> end of normalized string
normalize endp
; read_line - read one line from a file into line_buffer.
;
; Called with:
; BX = file handle
;
; Returns:
; If data read then: CF = 0, SI -> line, CX = length
; Else CF = 1 (implies end-of-file)
read_line proc near
mov si,OFFSET line_buffer ; SI -> line_buffer
mov cx,1 ; read one byte at a time
.re1: mov ah,3Fh ; DOS read function
mov dx,si ; DS:DX -> buffer
int 21H
jc .re5 ; if read error
test ax,ax
jz .re4 ; if EOF
mov al,[si] ; AL = byte just read
cmp al,' ' ; control character?
jb .re2 ; if so
inc si ; else bump buffer pointer
cmp si,OFFSET line_buffer+127; and check for overflow
jb .re1 ; handle over-long lines ungracefully!
.re3: xor ax,ax ; null terminate the line
mov [si],al
mov cx,si ; calculate its length
mov si,OFFSET line_buffer ; SI -> line_buffer
sub cx,si ; CX = line length
clc
ret ; return with CF zero and SI -> input, CX = length
.re2: cmp al,CR ; check for CR
jne .re1 ; and discard other control characters
jmp SHORT .re3 ; end the line on CR
.re4: cmp si,OFFSET line_buffer ; accept a last line with no CR
jne .re3
.re5: stc
ret ; EOF or read error, return with CF set
read_line endp
; reconstruct_command - reconstruct the text form of the current
; command.
;
; Returns:
; SI -> command key
reconstruct_command proc near
mov di,OFFSET line_buffer ; reconstruction done here
push di ; save a copy for later
mov si,current_command ; SI -> internal form of command
xor ax,ax ; get AX = command index
lodsb
mul command_entry_size ; calculate AX = offset of entry
push si
mov si,ax
mov si,WORD PTR [command_table+PC_KEY+si]
call copyz ; copy null-terminated string
mov al,' ' ; put in a blank
stosb
pop si
call copyz ; and copy the arguments
pop si ; return SI -> reconstructed text
ret
reconstruct_command endp
; resolve jumps - replace labels in Jump commands with offsets.
resolve_jumps proc near
.rj1: mov si,command_ptr ; SI -> next command
xor ax,ax
lodsb ; AX = command length
test ax,ax
jz .rj4 ; at end of script
add command_ptr,ax ; update the command pointer
lodsb ; AX = command index
cmp al,JUMP_INDEX ; is it a jump?
jne .rj1
mov di,si ; DI -> target label
mov si,OFFSET script_buffer ; scan through script for label
xor cx,cx
.rj2: add si,cx ; SI -> next command
xor ax,ax
lodsb ; AX = length of current command
test ax,ax
jz .rj3 ; at end of script
sub ax,2
mov cx,ax ; CX = length - 2
lodsb ; AX = command index
cmp al,LABEL_INDEX ; is it a label?
jne .rj2
call compare_strings
jne .rj2
add si,cx ; SI -> next command
mov [di],si ; overwrite label in jump
jmp SHORT .rj1
.rj3: mov si,di ; SI -> label
call ttyz ; display the offending line
mov dx,OFFSET .rjA ; DX -> "ERROR: Label not found."
stc
.rj4: ret
.rjA db CR,LF,'PAN Error: Label not found.$'
resolve_jumps endp
; restore_vector - restores a value into an interrupt vector
;
; On entry:
; AL = vector number
; DS:BX = address at old vector is stored
;
; Destroys AX.
restore_vector proc near
push si
push es
xor ah,ah ; calculate offset of vector
shl ax,1 ; = number * 4
shl ax,1
mov si,ax ; SI = offset of vector
xor ax,ax
mov es,ax ; ES:SI -> vector
pushf
cli ; interrupts off during switch
mov ax,[bx] ; move in the saved value
mov es:[si],ax
mov ax,[bx+2]
mov es:[si+2],ax
popf
pop es
pop si
ret
restore_vector endp
; run_it - transfer control to child program.
run_it proc near
mov ax,5000h ; DOS set PSP address
mov bx,child_psp ; BX = PSP of loaded program
int 21h
cli
mov pan_sp,sp ; save own SP
mov ss,child_ss ; set child's stack
mov sp,child_sp
sti
pop ax ; dump original drive valid flag
mov ax,cx ; set real drive valid flag
push child_cs ; set stack to "return" to child
push child_ip
mov es,child_psp
mov ds,child_psp ; DS = ES = child PSP
mov WORD PTR es:[000AH],OFFSET child_return
xor bx,bx
xor dx,dx
xor bp,bp
xor si,si
xor di,di
mov cs:in_pan_flag,bl ; clear in-Pan flag
retf ; Note that we are in a NEAR procedure
child_return: ; returns in PAN context except DS = ???
; SP restored from Load operation not from Go
mov ax,cs ; make sure DS and ES are set
mov ds,ax
mov es,ax
mov sp,pan_sp ; restore SP saved just above
call unset_traps ; should this be here ??? ***
mov al,pan_state ; check state while resetting it
cmp al,PS_OBIT ; waiting for this?
je .cr1 ; yes, continue
mov pan_state,PS_QUIT ; set state so death can occur and
jmp c_Quit ; quit if chump did not wait for die
.cr1: mov pan_state,PS_INITIAL ; revert to initial state
xor ax,ax
ret
run_it endp
; set_traps - capture the timer and BIOS-keyboard-function interrupts.
set_traps proc near
mov dx,OFFSET timer_intercept ; replace timer interrupt
mov al,8h
mov bx,OFFSET i_timer
call set_vector
mov dx,OFFSET BIOS_kb_intercept ; replace BIOS-kb interrupt
mov al,16h
mov bx,OFFSET i_BIOS_kb
call set_vector
ret
set_traps endp
; set_vector - copies the contents of an interrupt vector then stores
; a new value in the vector.
;
; On entry:
; AL = vector number
; DS:DX = new address for interrupt vector
; DS:BX = address at which to store old vector
;
; Destroys AX and BX.
set_vector proc near
push si
push es
xor ah,ah ; calculate offset of vector
shl ax,1 ; = number * 4
shl ax,1
mov si,ax ; SI = offset of vector
xor ax,ax
mov es,ax ; ES:SI -> vector
pushf
cli ; interrupts off during switch
mov ax,es:[si] ; move out the old
mov [bx],ax
mov ax,es:[si+2]
mov [bx+2],ax
mov es:[si],dx ; move in the new
mov ax,ds
mov es:[si+2],ax
popf
pop es
pop si
ret
set_vector endp
; set_video_address - set the video address corresponding to a given
; row and column.
;
; Called with:
; DX = screen position (DH = row, DL = column)
;
; Returns:
; ES:DI -> corresponding word in video buffer memory
set_video_address proc near ; DX = screen position
mov ax,video_segment
mov es,ax
xor di,di ; ES:DI -> start of video buffer
mov al,dh ; DH = row number
mul screen_columns
xor dh,dh
add ax,dx
add di,ax
add di,ax
ret ; returns ES:DI -> word in video buffer
set_video_address endp
; skip_whitespace - skip blanks and tabs in a string.
;
; Called with:
; SI -> string
;
; Returns:
; SI -> first character that is neither a blank nor a tab
; AL = that character
skip_whitespace proc near
.sw1: lodsb
cmp al,' '
je .sw1
cmp al,09h ; check for TAB
je .sw1
dec si
test al,al
ret ; returns SI -> first non-white char, AL = said char
skip_whitespace endp ; and ZR = 1 if character is a null
; stuff_keys - stuff keycodes into the BIOS keyboard buffer.
stuff_keys proc near
pushf ; save interrupt flag
push es
mov es,kbb_segment ; ES = keyboard-buffer segment
cli ; no interrupts while poking key buffer
.sk0: mov bx,es:[KBB_TAIL] ; get tail
mov di,bx ; and copy
inc bx ; bump tail pointer
inc bx
cmp bx,es:[KBB_END]
jne .sk1
mov bx,es:[KBB_START] ; if wrapped around
.sk1: cmp bx,es:[KBB_HEAD] ; any room in buffer
mov ax,1 ; for timeout
je .sk3 ; if not...
pop es
mov si,kiq_first ; SI -> string of key codes
call translate ; translate next character
mov kiq_first,si ; update pointer
push es
jc .sk4 ; if at end of string
mov es,kbb_segment ; ES = keyboard-buffer segment
stosw ; store scan code and ASCII to KBB
mov es:[KBB_TAIL],bx ; update tail
mov ax,type_rate ; AX = inter-key delay (in ticks)
test ax,ax
jz .sk0 ; if zero just continue
.sk3: mov time_out,ax ; set new timeout
.sk4: pop es
popf
ret
stuff_keys endp
; terminate - terminate the current program.
terminate proc near
mov ax,4C00h ; DOS terminate a program
int 21h
terminate endp
; translate - translates a character in keyboard format
;
; Called with:
; SI -> string of encoded key symbols
;
; Returns:
; CF = 0 if character available, and
; AX = key code suitable for insertion into BIOS keyboard buffer
; DL = shift status for character
; CF = 1 if end-of-string
translate proc near ; SI -> key spec
push bx ; save all registers but those
push cx ; used to return stuff
push di
.tra1: xor dx,dx ; prepare DL to hold shift information
; We start by checking for a caret which is usually a Ctrl-shift indicator
.tra2: cmp [si],BYTE PTR '^' ; Ctrl-shifted character?
jne .tra3
inc si
cmp [si],BYTE PTR '^' ; doubled?
je .tra8 ; send character
or dl,04h ; set "Ctrl key is down" bit in status
.tra3: cmp [si],BYTE PTR '[' ; special-key delimiter?
jne .tra8
inc si ; push pointer past \
cmp [si],BYTE PTR '[' ; doubled?
je .tra8 ; '[[' means '['
mov bx,si ; save pointer to '['
.tra4: lodsb ; search for closing ']'
test al,al ; or end of string
jz .tra6 ; if no closing ']'
cmp al,']'
jne .tra4
dec si
mov BYTE PTR [si],0 ; replace the ']' with a null
mov si,bx ; SI -> keyname
mov bx,OFFSET shiftname_list; check the list of shift-key names
call match_key ; look it up
jne .tra5 ; if no match
inc si ; push SI past the null
mov bx,ax
or dl,[shiftbits+bx] ; or bit for shift key into DL
jmp SHORT .tra2
.tra5: mov bx,OFFSET keyname_list ; try other named keys
call match_key ; look it up
jne .tra6 ; if no match
inc si ; push SI past the null
mov bx,ax
mov ah,[key_scans+bx] ; AH = scan code
xor al,al ; AL = zero
jmp SHORT .tra9
.tra6: mov al,[si] ; AL = character following '['
call is_digit ; only valid thing now is a decimal
jc .tra8 ; code of exactly three digits
xor ax,ax
call decode_decimal ; decode the code
cmp BYTE PTR [si],']'
stc
jne .tra12
inc si ; push SI past ']'
test al,al
jz .tra1 ; zero is invalid
test ah,ah
jz .tra11 ; accept only codes between 1 and 127
.tra7: jmp .tra1 ; need a long jump here
.tra8: xor ax,ax ; load and return literal ASCII
lodsb
test al,al ; test for end of string
stc ; at end we return with CF set
jz .tra12
js .tra11 ; if extended ASCII (no scan code)
mov bx,ax
mov ah,[scan+bx] ; AH = scan code
xor bx,bx ; check if we need to add a Shift
mov bl,ah
add bx,bx
add bx,OFFSET No_shift
cmp [bx],al
je .tra9 ; if char matches without a Shift
or dl,02h ; assume a Left Shift
; Convert ASCII and scan codes according to shifts
.tra9: test dl,08h ; Alt takes precedence
mov bx,OFFSET Alt_shift
jnz .tra10
test dl,04h ; Ctrl is next
mov bx,OFFSET Ctrl_shift
jnz .tra10
test dl,03h ; Shift is lowest
mov bx,OFFSET Shift_shift
jnz .tra10
mov bx,OFFSET No_shift
.tra10: xchg al,ah ; get scan code in AL
xor ah,ah
add ax,ax ; convert to word index
add bx,ax ; BX -> entry in shift table
mov ax,[bx] ; load revised codes
test ax,ax ; zero entry means key combination
jz .tra7 ; generates nothing
.tra11: clc ; return character and CF = 0
.tra12: pop di
pop cx
pop bx
ret
translate endp
; ttyz - display a null-terminated string at the cursor using the BIOS.
;
; Called with:
; SI -> string
ttyz proc near
xor bx,bx ; assume page 0
.tz1: lodsb ; do it one character at a time
test al,al
jz .tz2
mov ah,0Eh ; using the BIOS
int 10h
jmp SHORT .tz1
.tz2: ret
ttyz endp
; unset_traps - remove traps set by set_traps.
unset_traps proc near
mov ax,x_timer_offset ; were traps set?
or ax,x_timer_segment
jz .uns1 ; skip if not
mov al,8h ; remove timer intercept
mov bx,OFFSET i_timer
call restore_vector
mov al,16h ; remove BIOS-keyboard intercept
mov bx,OFFSET i_BIOS_kb
call restore_vector
.uns1: ret
unset_traps endp
; Interrupt stack
dw 80h DUP (0)
interrupt_stack LABEL WORD ; stack used within interrupts
script_buffer db 0 ; script loaded starting here
code ends
end start
