;PACKARD 1/23/80 ;XYBASIC Interpreter Source Module ;Copyright (C) 1979, 1980 by Mark Williams Company, Chicago ;Custom version for Packard Instruments if packi ;Packard Instruments XYBASIC stores the ASCII data from ONLINE or OFFLINE ;instruments in the buffer PADAT. The format of the PADAT entries is: ;A completed data record consists of a FLAG byte of 0, followed by ; significant ASCII data fields, each terminated by . ;An incomplete data record consists of a FLAG byte of 1, followed by data. ;A data buffer overflow is indicated by a FLAG byte of 2. ;A line of more than PACMX chars is indicated by a FLAG byte of 3. ;A synch error is indicated by a FLAG byte of 4. ;The field buffer PAFLD contains the number of fields per record in its ;first byte, and an ordered list of significant record numbers in ;successive bytes, terminated by 0. ;The RAM locations used during data collection and analysis are: ;PAONL Online flag [0 OFFLINE, 255 ONLINE] ;PADP0 Pointer to FLAG byte of current/next data record for INPUT @. ;PADP1 Pointer to data byte of current/next data record for INPUT @. ;PADP2 Pointer to next available location of currently incompleted record. ;PADP3 Pointer to FLAG byte of currently incompleted record. ;EQUates padct equ 400 ;length of data buffer pafct equ 35 ;length of FIELD buffer pacmx equ 90 ;max # chars in line paind equ 7EH ;data port pains equ 7FH ;status port ;commands ;FIELD [, ] * ;The FIELD command initializes the buffer PAFLD. field: call pinit ;reinitialize the data buffer lxi h,paign ;reset flags for PADAT mov m,a ;set IGNORE flag to 0 inx h mvi m,pacmx ;set COUNT to PACMX inx h mov m,a ;set MODE flag to 0 inx h mvi m,1 ;set next field # to 1 lxi h,pafld+1 shld pafbp ;set PAFBP to first buffer location dcx h lxi d,1FFH ;1 to D, 255 to E call fiel0 ;get field count and store inr a mov e,a ;count+1 to E fiel1: inx h ;point to next buffer loc mvi m,0 ;store possible eof push h call gtcnd ;look for comma pop h rc ;none, done call fiel0 ;get next field value and store inr a mov d,a ;last value + 1 to D jmp fiel1 ;and look for more values ;FIEL0 gets a parameter for FIELD command and stores it in buffer. ;A fatal FI error occurs if the parameter value is <0, >255, <(D) or >=(E). ;Call: D most recent value + 1 ; E max value + 1 ;Retn: A,M value ; DE,HL preserved fiel0: call gtexp ;value to BC mov a,b ora a jnz fierr ;fatal FI error if <0 or >255 mov a,c ;fetch value mov m,a ;and store it cmp d jc fierr ;< last+1, fatal FI error cmp e rc ;< max+1, ok fierr: xra a sta pafld ;reset FIELD buffer on FI errors error f, f, i ;and issue fatal FI error ;INPUT @ ;The INPUT @ command reads data from the data buffer. painp: lda pafld ora a jz fierr ;fatal FI error if no FIELD command executed lhld savtp shld txtp2 call flip ;save TEXTP, reset TEXTP in case ^C typed pain0: call ctest ;look for console break char lhld padp1 ;first char pointer to HL mov a,m ;fetch first char cpi 1 jz pain1 ;data not ready, FLAG = 1 cpi 20H jnc pain2 ;printable char, do the INPUT call painx ;else increment the first char pointer call pain5 ;store new value and update FLAG pointer jmp pain0 ;and retry ;at PAIN1 data is not ready, so read chars if OFFLINE and retry pain1: lda paonl ;fetch ONLINE status ora a ;Zero set iff OFFLINE jnz pain0 ;ONLINE, just retry until FLAG indicates ready if nonst mvi c,cntlq call pout ;XON to turn on reader else mvi a,cntlq call writc endif lhld padp1 ;FLAG pointer to HL pai1a: call ctest ;look for console break char call pardr ;read char and store mov a,m ;fetch current FLAG dcr a ;Zero set iff FLAG is 1, i.e. not ready jz pai1a ;not ready, keep waiting lda pamod ;fetch mode cpi 3 jnc pai1a ;wait for before issuing XOFF if nonst mvi c,cntls call pout ;XOFF to turn off reader else mvi a,cntls call writc endif jmp pain0 ;and retry ;At PAIN2 the next data char is printable, so the INPUT is performed. ;First the next field is moved to the input buffer. pain2: xra a sta cstkd ;clear cstack direct count lxi b,nlnad ;input buffer address to BC push b pain3: mov a,m ;fetch char from data buffer stax b ;and store in input buffer inx b ;increment input buffer pointer push psw call painx ;and data buffer pointer pop psw cpi cr jnz pain3 ;continue until cr found call pain5 ;update data buffer and FLAG pointers ;Next the INPUT is performed. pop h shld textp ;input buffer address to TEXTP call flip ;restore TEXTP, save input buffer pointer call gtlhs ;find destination if strng cpi strst jz pain6 ;string destination endif call flip ;to parse input buffer call gtlit ;evaluate data item jc exerr ;error in data item call asigv ;assign value to destination call flip ;to parse text again ;The is checked for additional elements. pain4: call gtcnd ;look for comma jnc painp ;repeat if more variables follow ;If ONLINE, DTR line pulled high if > 80H bytes remain free. lda paonl ;fetch ONLINE status ora a rz ;done if OFFLINE lhld padp2 ;last to HL xchg call cplde ;-last to DE lhld padp0 ;first to HL dad d ;first-last = space remaining cnc pas16 lxi d,80H call cmdhu rnc ;remaining <= 80H bytes, just return if not debug mvi a,37H out pains ;else pull DTR line high endif ret ;else done pain5: shld padp1 ;update data buffer pointer mov a,m ;fetch next char cpi 5 ;check if flag follows rnc ;no, leave FLAG pointer unchanged shld padp0 ;else update FLAG pointer ret ;and return ;string destination, consider field as unquoted string if strng pain6: mvi c,0FFH ;string length to C lxi h,nlnad ;location to HL mov d,h mov e,l ;and to DE pain7: mov a,m ;fetch string char inx h inr c ;bump length cpi cr jnz pain7 ;scan until cr mvi a,strst ;result type = string to A call asigv ;assign value to destination jmp pain4 ;continue scanning as above endif ;OFFLINE | ONLINE onlin: stc oflin: sbb a ;A gets 0 for OFFLINE, 255 for ONLINE sta paonl ;set PAONL accordingly ret ;functions ;FLAG: --> ;FLAG just returns current FLAG if ONLINE or FLAG <> 1. ;If OFFLINE and FLAG=1, then looks to RDR for data. flag: lhld padp0 ;FLAG pointer to HL lda paonl ;fetch ONLINE status ora a ;Zero set iff OFFLINE mov a,m ;fetch FLAG value jnz flag3 ;ONLINE, take given FLAG value cpi 1 jnz flag3 ;FLAG not not ready, take value given if nonst mvi c,cntlq call pout ;XON to turn on reader else mvi a,cntlq call writc endif flag1: xchg ;save FLAG pointer lxi h,-521 ;2MHz / (15*256) cycles = 1 sec call timer ;delay until char or 1 second elapses xchg ;restore FLAG pointer jnc flag2 ;timeout, take given FLAG call pardr ;char ready, read it and srore it mov a,m ;fetch possibly altered FLAG dcr a jz flag1 ;not ready FLAG, look for more chars lda pamod ;fetch mode cpi 3 jnc flag1 flag2: if nonst mvi c,cntls call pout ;XOFF to turn off reader else mvi a,cntls call writc endif mov a,m ;fetch flag flag3: mov c,a mvi b,0 ;value to BC cpi 2 cnc painx ;increment pointer if value is 2, 3, or 4 shld padp0 ;and store new FLAG pointer ret ;routines ;PINIT initializes PAFLD and PABUF, and is called from CLEAR and FIELD. ;Retn: A 0 ; HL PADAT+1 pinit: xra a sta pafld ;clear FIELD buffer lxi h,padat mvi m,1 ;set initial FLAG value to 1 shld padp0 ;set FLAG pointer shld padp1 ;and first used char pointer shld padp3 ;and current record FLAG pointer inx h shld padp2 ;and next available pointer if not debug mvi a,37H out pains ;else pull DTR line high xra a endif ret ;PAISR is the interrupt service routine. paisr: push psw lda paonl ;fetch ONLINE status ora a ;Zero set iff OFFLINE in paind ;read the data cnz pasto ;and store it if ONLINE pop psw ei ret ;PAINX increments HL to next PABUF location. ;Call: HL pointer into PABUF ;Retn: A,DE Clobbered ; BC Preserved ; HL Pointer to next PABUF location painx: inx h ;point to next lxi d,padat+padct ;last buffer location + 1 to DE call cmdhu ;compare last to next rnz ;return if not at end of buffer lxi h,padat ;else first buffer location is next ret ;PARDR reads a char for OFFLINE data collection and stores it in PADAT. pardr: if cpm ;prompt for char in CP/M version push h call prntm db 'OFFLINE char?', cr, lf or 80H pop h endif call readc ;read and fall through to PASTO to store ;PASTO stores the char from A to the Packard data buffer PADAT, as desired. ;The current data item state is indicated by several RAM values. ;PAIGN Ignore flag [0 normally, nonzero between ONLINE TAPEOFF and TAPEON] ;PACNT Count, 80 - chars in current line ;PAMOD Mode [0 waiting for field, 1 receiving significant field, ; 2 receiving insignificant field, 3 receiving chars before cr, ; 4 receiving ignored chars of bad line] ;PAFNO Field number of next/current field ;PAFBP Pointer to field number of next significant field (in PAFLD) ;The parity bit is stripped from A, all other registers are preserved. pasto: ani 7FH ;mask possible parity bit rz ;ignore nulls push4 ;save registers lxi h,pop4 push h ;push return to POP4 to allow RET mov b,a ;save char in B lda pafld ora a rz ;ignore if FIELD = 0 lxi h,paign ;address ignore flag lda paonl ;fetch online mode ora a jz past1 ;ignore TAPEON/TAPEOFF flag if OFFLINE mov a,b ;refetch char cpi cntlt ;test for TAPEOFF, i.e. ^T jz past9 ;TAPEOFF, set ignore flag sui cntlr ;test for TAPEON, i.e. ^R jz past9 ;TAPEON, clear ignore flag mov a,m ;fetch ignore flag ora a rnz ;ignoring (since previous TAPEOFF) past1: inx h ;address PACNT mov a,b ;refetch char cpi cr jnz past2 mvi m,pacmx+1 ;reset PACNT on past2: dcr m ;decrement PACNT mvi c,3 ;possible error flag value = 3 to C inx h ;address PAMOD mov a,m ;fetch mode jm past4 ;line too long cpi 1 jz pas12 ;mode=1, receiving significant field cpi 2 mov a,b ;restore char to A jz pas10 ;mode=2, receiving insignificant field jnc pas11 ;mode=3 or 4, receiving chars after last ;waiting for first char of field call patst ;test if field char rc ;no, ignore and keep waiting ;field char received, go from waiting to receiving state mvi m,2 ;set mode to 2, assuming insignificant xchg ;mode pointer to DE lda pafno ;fetch current field # lhld pafbp ;significant field pointer to HL cmp m ;check if significant rnz ;insignificant, done inx h ;increment significant field pointer shld pafbp ;and store xchg ;mode pointer to HL dcr m ;decrement mode to 1, significant mov a,b ;restore new char ;PAST3 stores the char from A to PABUF, preserving BC. past3: lhld padp2 ;address next available buffer location mov m,a ;store char call painx ;increment buffer loc shld padp2 ;and store new next avail pointer xchg call cplde ;-last to DE lhld padp0 ;first used loc to HL dad d ;first-last = space remaining cnc pas16 ;add PADCT if first > last lxi d,5 call cmdhu ;check amount of free buffer space remaining rc ;>5 bytes free, just return mvi e,2 call cmdhu ;check if 0 or 1 byte remains jnc past5 ;yes, out of space lda paonl ;fetch ONLINE status ora a rz ;done if OFFLINE if not debug mvi a,35H out pains ;pull DTR (on bit 1) low endif ret ;line too long, issue error unless issued already past4: cpi 4 ;check mode rz ;done if error already jmp past6 ;else issue error ;buffer overflow has occurred, purge most recent info past5: mvi c,2 ;error flag value to C past6: lxi h,pamod ;address PAMOD mvi m,4 ;set mode to ignore remainder of line inx h mvi m,1 ;set PAFNO to 1 for next field received lhld padp0 xchg ;first FLAG location to DE lhld padp3 call cmdhu ;check if current is first jz past7 ;yes lxi d,padat call cmdhu ;check if current is start of buffer cz pas16 ;yes, point to end of buffer + 1 dcx h ;point to location before current mov a,m ;and fetch its value cpi 5 ;check if it contains FLAG cnc painx ;not a flag, reincrement to current shld padp3 ;and store current flag pointer past7: mov m,c ;error flag to current flag loc call painx past8: mvi m,1 ;store new flag byte for next entry call painx shld padp2 ;reset next avail pointer ret past9: mov m,a ret ;receiving insignificant field pas10: call patst rnc ;ignore if field char jmp pas13 ;else continue as below ;receiving chars after last significant field of record pas11: cpi cr jz pas14 ;, done mov a,m ;refetch mode cpi 4 rz ;ignore if error has ocurred mov a,b ;restore char to A call patst rc ;ignore nonfield chars mvi c,4 ;error code = 4 to C jmp past6 ;and issue error ;receiving significant field pas12: mov a,b ;restore char to A call patst jnc past3 ;store another char of field mvi a,cr ;field is completed call past3 ;so store a cr pas13: lxi h,pamod ;insignificant field entry point mvi m,0 ;reset mode to 0 = waiting inx h ;address current field PAFNO inr m ;and increment lda pafld ;fetch max field cmp m ;compare to current rnc ;max >= next, continue same record mvi m,1 ;record is complete, so set next field to 1 dcx h mvi m,3 ;and set mode to 3 in case no yet mov a,b cpi cr ;check if terminates record rnz ;no , may be more chars following pas14: mvi m,0 ;end of record found lxi h,pafld+1 shld pafbp ;reset significant field pointer lhld padp3 dcr m ;check if 1 jnz pas15 ;error occurred during record, ignore record lhld padp2 shld padp3 ;reset current FLAG byte pointer jmp past8 ;store new entry flag byte pas15: inr m ;restore correct error code call painx shld padp3 ;reset current record flag pointer jmp past8 ;and reset next avail pointer pas16: lxi d,padct dad d ret ;PATST determines whether char in A is a legal Packard numeric ;field character, namely: + - . 0 1 2 3 4 5 6 7 8 9 ;Call: A Char ;Retn: ABCDEHL Preseved ; Carry Set iff not a legal numeric field char patst: cpi '9'+1 cmc rc ;> '9', not a legal char cpi '0' rnc ;'0' <= char <= '9', ok cpi '.' rz cpi '-' rz cpi '+' rz stc ;not a legal char ret endif ;end of PACKI conditional ;end of PACKARD