|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 68466 (0x10b72)
Notes: pts_type(SC)
Names: »UNPACK.SC«
└─⟦025d39960⟧ Bits:30009672 Philips computer tape "600133"
└─⟦this⟧ »A:DSB/UNPACK.SC«
IDENT UNPACK 811016-NJ
************************************************************************
* THIS ROUTINE PERFORMS BUFFER MOVEMENT AND DATA CONVERSION, DISPLAY*
* AND PRINTING OF INFORMATION NECESSARY FOR THE DSB PLADS RES. APPL.*
* CALLING SEQUENCE:*
* *
* CALL UNPACK,WORK,INBUF,INLEN,OUTBUF,OUTLEN,FLDTAB,DSDY,DSGP*
**
* PARAMETERS ARE:*
* WORK, BINARY ARRAY OF 12 ELEMENTS (SCRATCH AREAS)*
* INBUF, STRING ITEM, INPUT BUFFER*
* INLEN, BINARY ITEM, INPUT BUFFER LENGTH*
* OUTBUF, STING ITEM, DATA-COMM OUTPUT BUFFER*
* OUTLEN, BINARY ITEM, OUTPUT BUFFER LENGTH*
* FLDTAB, BINARY ARRAY (21 X 4), DESCRIPTION OF INPUT FIELDS*
* DSDY, DATA SET, FOR PDU 6386*
* DSGP, DATA SET, FOR GTP 6221, (MODIFIED DK PAPER OUT)*
**
* INPUT PARAMETERS:*
* *
* INBUF, INLEN*
**
* OUTPUT:*
**
* OUTBUF, OUTLEN, FLDTAB*
* DISPLAYED BUFFER, PRINTED FORM*
**
************************************************************************
EJECT
************************************************************************
**
* ENTRIES AND EXTERNAL REFERENCES*
**
************************************************************************
ENTRY UNPACK
ENTRY FLASH COMMAND FROM KB TASK
EXTRN I:EVA0,T:FDSP ROUTINES TO PICK UP PARAMETERS
EXTRN I:RT1 ROUTINE TO RETURN TO CREDIT
EXTRN MSKTAB,TABEND TABLES FOR INPUT FIELD DESC.
EJECT
************************************************************************
**
* CONSTANTS*
**
************************************************************************
SO EQU /0E0E SHIFT OUT
SI EQU /0F0F SHIFT IN
LF EQU /0A0A LINE FEED
CR EQU /0D0D CARRIAGE RETURN
CRLF EQU /0D0A
NULL EQU /0000 NULL CHAR.
POINT EQU /AE POINT CHAR.
PRTCHR EQU /3A3A PRINT INDICATOR = :
LFCHR EQU /0A LINE FEED FOR GP
MLF2 EQU /3C3C MULTIPLE LINE FEEDS(2)
MLF6 EQU /3D3D " " " 6
SPACE EQU /20 SPACE CHARACTER
SPACES EQU /2020 TEST SPACE CHARACTER
ACK EQU /2B PRINTER ACKNOWLEDGEMENT
NAK EQU /3E PRINTER NEG. "
PNTCHK EQU /AEAE POINT IN PRINTER BUFFER
DKOE1 EQU /4040
DKAE1 EQU /2323
DKAA1 EQU /2424
CHRFD1 EQU /0909 NONDESTRUCTIVE SPACE FWD
DKOE2 EQU /5C
DKAE2 EQU /5B
DKAA2 EQU /5D
CHRFD2 EQU /10
EJECT
* PTS 6386 CONTROL CHARACTERS*
CURLFT EQU /08 CURSOR LEFT
CURHOM EQU /0B CURSOR HOME
CLEAR EQU /0C CLEAR SCREEN, CURSOR HOME
CURRGT EQU /10 CURSOR RIGHT
SETCUR EQU /11 SET CURSOR POSITION
XADR0 EQU /20 LINE POSITION = 0,(OFF-SCREEN)
YADR0 EQU /20 COLUMN POSITION = 0. "
CURON EQU /15 CURSOR ON
CUROFF EQU /16 CURSOR OFF
CRBLNK EQU /17 CURSOR BLINK
CRSTDY EQU /18 CURSOR STEADY
FAST EQU /1420 FAST OUTPUT (/20=LENGTH ZERO)
BASWRT EQU /85 ORDER BASIC WRITE
STATUS EQU /80 TEST STATUS ORDER
DCWRT EQU /86 WRITE WITH WAIT
EJECT
************************************************************************
**
* WORK AREA DISPLACEMENTS, (POINTERS)*
**
************************************************************************
INBUF EQU 0 START OF WORK AREA. INBUF
INLEN EQU INBUF+2 LENGTH OF INBUF
OUTBUF EQU INLEN+2 OUTPUT BUFFER
OUTLEN EQU OUTBUF+2 LENGTH OF OUTPUT BUFFER
FLDTAB EQU OUTLEN+2 TABLE DESCRIBING INPUT FIELDS
DYECB EQU FLDTAB+2 DISPLAY EVENT CONTROL BLOCK
GPECB EQU DYECB+2 PRINTER EVENT CONTROL BLOCK
PRINT EQU GPECB+2 PRINT FLAG
DCECB EQU PRINT+2 DATA-COMM EVENT CONTROL BLOCK
WORK1 EQU DCECB+2 SCRATCH AREAS
WORK2 EQU WORK1+2
WORK3 EQU WORK2+2
CURSAV EQU WORK3+2 SAVE AREA FOR CURSOR POSITIONS
*
* WORK AREA FOR FLASHING FIELDS
*
FLATAB EQU CURSAV NUMBER OF FIELDS
FLACUR EQU 0 CURSOR POSITION
FLINPO EQU 2 POSITION IN INPUT BUFFER
FLALEN EQU 4 LENGTH OF FIELD
BLANKS EQU FLATAB+62 BUFFER FOR BLANKING
*
*
ECB EQU 0 START OF AN ECB
ECBBA EQU 2 ECB WORD DISPLACEMENTS
ECBRL EQU 4
ECBEL EQU 6
ECBRC EQU 8
ECBCW EQU 10
EJECT
************************************************************************
**
* UNP000*
* MAIN MODULE *
* CALLS SUB-MODULES, UNP100, THRU UNP900 TO PERFORM*
* THE REQUIRED FUNCTIONS*
* ENTRY : UNPACK = UNP000*
* EXITS VIA ABL I:RT1*
**
************************************************************************
UNPACK EQU *
UNP000 EQU *
CF A14,UNP100 GET PARAMETERS AND FILL WORK
AREAS, NO CHECK ON INPUT IS
PERFORMED.
CF A14,UNP200 MOVE AND CONVERT INPUT BUFFER
TO DISPLAY BUFFER
CF A14,UNP300 WRITE BUFFER TO DISPLAY, THIS
ROUTINE CONTAINS THE LKM...
CF A14,UNP900 SET FLASHING FIELDS IF ANY
LD A2,WORK1,A4 ANYTHING TO PRINT?
RF(NZ) UNP060 YES
CF A14,UNP400 BUILD INPUT FIELD TABLE
LD* A2,FLDTAB,A4 WAS IT A MASK?
RF(Z) UNP090 NO, IT'S A TEST OR SOMETHING
LD A2,WORK2,A4 IS IT AN ERROR MESSAGE?
RF(N) UNP090 YES, SKIP THE REST
CF A14,UNP500 COPY INPUT FIELDS TO DC OUTPUT
BUFFER, FILL IN LENGTH
RF UNP090 RETURN
UNP060 EQU *
CF A14,UNP600 FILL IN TICKET / FORM.
CF A14,UNP700 PRINT TICKET / FORM
CF A14,UNP800 ACKNOWLEDGE PRINT OPERATION
RF UNP090
FLASH EQU *
CF A14,KBFLSH FLASH COMMAND
UNP090 EQU *
ABL I:RT1 RETURN TO CREDIT CODING
EJECT
************************************************************************
* *
* *
* *
* UNP100 *
* *
* *
* *
************************************************************************
UNP100 EQU *
CF A14,I:EVA0 GET POINTER TO WORK AREA
LDR A4,A9 PUT IT IN A4 AS BASE REGISTER
CF A14,I:EVA0 GET INPUT BUFFER ADDRESS
ST A9,INBUF,A4 PUT IT IN WORK AREA
CF A14,I:EVA0 GET BUFFER LENGTH ADDRESS
LD A5,0,A9 GET LENGTH
ST A5,INLEN,A4 PUT IT IN WORK AREA
CF A14,I:EVA0 GET OUTPUT BUFFER ADDRESS
ST A9,OUTBUF,A4 PUT IT IN WORK AREA
CF A14,I:EVA0 GET OUTPUT BUFFER LENGTH ADDR.
ST A9,OUTLEN,A4 LEGNTH
CF A14,I:EVA0 GET INPUT FIELD TABLE ADDRESS
ST A9,FLDTAB,A4 PUT IT IN WORK AREA
CF A14,T:FDSP GET DISPLAY ECB ADDRESS
ST A8,DYECB,A4 PUT IT IN WORK AREA
CF A14,T:FDSP GET PRINTER ECB ADDRESS
ST A8,GPECB,A4 PUT IT THERE ALSO
CF A14,I:EVA0 GET PRINT FLAG
ST A9,PRINT,A4 PUT IT IN WORK AREA
CF A14,T:FDSP GET DATA-COMM ECB ADDRESS
ST A8,DCECB,A4 PUT IT IN WORK AREA
CF A14,I:EVA0 GET ACK/NAK BUFFER
ST A9,2,A8 SAVE IN ECB
RTN A14
EJECT
************************************************************************
* *
* *
* *
* UNP200 *
* *
* *
* *
************************************************************************
UNP200 EQU *
LDK A1,1 SET LINE POS. COUNTER TO ONE
LDKL A9,/0100 SET THE LINE COUNTER TO FIRST LINE
LDKL A10,CURSAV GET SAVE AREA FOR CURSORS
ADR A10,A4 ADD THE BASE
LD A3,INBUF,A4 GET ADDRESSES OF BUFFERS AND
LDKL A5,300 FIXED LENGTH
LD A8,DYECB,A4
LD A6,ECBBA,A8
LDR A1,A6 TEST FOR BUFFER END
ADKL A1,300
LDK A2,SPACE BLANKING CHARACTER
UNP202 EQU *
SCR A2,A6 BLANK A CHAR. IN DY BUFFER
ADK A6,1 MOVE THE POINTER
CWR A6,A1 END OF BUFFER ?
RF(G) UNP204 YES, FINISHED
RB UNP202 NO, CONTINUE
UNP204 EQU *
LD A6,ECBBA,A8 RESTORE BUFFER ADDR.
LDK A1,1 SET LINE POS. COUNTER TO ONE
ADK A6,1 OFF-SET FOR CURSOR HOME
LDK A7,0 NUMBER OF CHARACTERS PROCESSED
CM WORK1,A4 CLEAR OLD PRINT FLAG
UNP205 EQU *
LCR A2,A3 CHECK CHARS. TO BE REMOVED OR
CCK A2,NULL CONVERTED
RF(E) UNP235 NULL.
CCK A2,DKOE1
RF(E) UNP236
CCK A2,DKAE1
RF(E) UNP237
CCK A2,DKAA1
RF(E) UNP238
CCK A2,CHRFD1
RF(E) UNP239
CCK A2,SI
RF(E) UNP240 SHIFT IN
CCK A2,SO
RF(E) UNP245 SHIFT OUT
UNP210 EQU *
CCK A2,CR CHECK CONTROL CHARACTERS
RF(E) UNP225 CARRIAGE RETURN
CCK A2,LF
RF(E) UNP230 LINE FEED
CCK A2,PRTCHR SEE IF IT'S A TICKET
RF(E) UNP234 YES, SET INDICATOR
UNP215 EQU *
SCR A2,A6 PUT CHAR. IN DY BUFFER
ADK A6,1 UPDATE POINTERS
ADK A1,1
SUK A1,41 CHECK FOR END OF LINE
RF(N) UNP220 NOT END OF LINE
ADKL A9,/0100 UPDATE LINE COUNT
CWK A9,/0600 LINE SEVEN ?
RF(G) UNP290 YES, FINISHED
LDKL A2,CRLF END OF LINE, INSERT LINE FEED
SCR A2,A6 AND CARRIAGE RETURN
ADK A6,1
SRL A2,8
SCR A2,A6
ADK A6,1 UPDATE POINTERS
LDK A1,1
RF UNP250 CHECK END OF PROCESSING
UNP220 EQU *
ADK A1,41 RESTORE POINTER VALUE
RF UNP250 CHECK END OF PROCESSING
UNP225 EQU *
UNP230 EQU *
LDK A1,0 LINE FEED IN BUFFER RESET
ADKL A9,/0100 ADD A LINE
LDKL A2,CRLF IT'S A NEW LINE
SCR A2,A6 STORE IT IN OUTUT
SRL A2,8
ADK A6,1 ADJUST POINTER
RB UNP215 FINISH IT
UNP234 EQU *
ST A2,WORK1,A4 SOMETHING TO PRINT
RB UNP215
UNP235 EQU *
LDK A2,POINT NULL CHAR. REPLACE WITH POINT
RB UNP215
UNP236 EQU *
LDK A2,DKOE2
RB UNP215
UNP237 EQU *
LDK A2,DKAE2
RB UNP215
UNP238 EQU *
LDK A2,DKAA2
RB UNP215
UNP239 EQU *
LDK A2,CHRFD2
RB UNP215
UNP240 EQU *
ORR A9,A1 BUILD CURSOR POSITION
ST A9,2,A10 PUT IT IN SAVE AREA
ADKL A10,2 MOVE POINTER TO NEXT ENTRY
ANKL A9,/FF00 CLEAR LINE POS. FOR COUNTER
UNP245 EQU *
* "SI" OR "SO", SKIP 'EM
UNP250 EQU *
ADK A3,1 UPDATE INPUT POINTER
ADK A7,1 CHECK IF END OF INPUT
SUR A7,A5 BUFFER
RF(NN) UNP285 END OF PROCESS
ADR A7,A5 NOT ENDED, RESTORE VALUE
RB UNP205 GET NEXT CHARACTER
UNP285 EQU *
SUK A3,1 GO BACK ONE POSITION
LCR A2,A3 GET LAST CHARACTER IN BUFFER
CCK A2,PRTCHR SOMETHING TO PRINT?
RF(NE) UNP290 NO, RETURN
ST A2,WORK1,A4 SET PRINT FLAG = X'3A'
UNP290 EQU *
LDKL A9,CURSAV PUT THE NUMBER OF INPUT FIELDS
ADR A9,A4 IN THE SAVE AREA
SUR A10,A9
ST A10,CURSAV,A4 SAVE IT,(2X NUMBER OF FIELDS)
RTN A14 RETURN TO CALLER..
EJECT
************************************************************************
* *
* *
* *
* UNP300 *
* *
* *
* *
************************************************************************
UNP300 EQU *
LD A8,DYECB,A4 GET ECB ADDRESS IN A8
LD A1,ECBBA,A8 COMPUTE BUFFER LENGTH
LDK A2,CURHOM AND INSERT CURSOR HOME.
SCR A2,A1
SUR A6,A1
LDKL A6,300 FIXED LENGTH TO DISPLAY 271181
ST A6,ECBRL,A8 PUT IN ECB
LDK A7,BASWRT GET ORDER IN A7
*
*
LKM EXECUTE I-O
DATA 1
RTN A14
EJECT
************************************************************************
* *
* *
* *
* UNP400 *
* *
* *
* *
************************************************************************
UNP400 EQU *
CM WORK2,A4 CLEAR ERROR MESS. FLAG
LC* A1,INBUF,A4 SEE IF IT'S A MASK
ANKL A1,/00FF
CCK A1,LF
RF(E) UNP410 NOT A MASK
CCK A1,SI
RF(E) UNP410 NOT A MASK
LD A3,INBUF,A4 GET KEY TO MASKS
ADK A3,5 FIRST CHARACTER
LCR A1,A3 GET IT
ANKL A1,/00FF CLEAN IT
ADK A3,1 GET NEXT ONE
LCR A2,A3
ANKL A2,/00FF
SLL A1,8 MAKE ROOM
ORR A1,A2 MERGE THEM
*
CF A14,SRCHTB GO LOOK FOR THE MASK
*
LDR A2,A2 CHECK RETURN VALUE
RF(Z) UNP415 NO MASK FOUND
*
CF A14,MOVMSK MASK FOUND, MOVE IT TO FLDTAB
CF A14,FILCUR FILL IN CURSOR POSITIONS.
RF UNP412
*
UNP410 EQU *
LDKL A3,-1 INDICATE NO MASK
ST A3,WORK2,A4
UNP412 EQU *
RTN A14 RETURN TO CALLER
UNP415 EQU *
CM* FLDTAB,A4 INDICATE FLDTAB NOT VALID
RB UNP412
EJECT
************************************************************************
* *
* *
* *
* SRCHTB, ROUTINE TO FIND MASK IN MASK TABLE... *
* *
* *
* *
************************************************************************
* CALLING SEQUENCE: CF A14,SRCHTB*
* A1 = KEY, (TWO CHARACTERS)*
* RETURNS: A2 = 0, NO MASK FOUND*
* A2 /= 0, ADDRESS TO MASK TABLE*
SRCHTB EQU *
LDK A2,0 PRE-SET RETURN VALUE
LDKL A3,MSKTAB GET START OF TABLE
UNP460 EQU *
CWR* A1,A3 MATCH KEY
RF(E) UNP470 FOUND.
ADK A3,4 CHECK NEXT
CWK A3,TABEND LAST?
RB(L) UNP460 NO, GO FURTHER
UNP465 EQU *
RTN A14 END, RETURN TO CALLER
UNP470 EQU *
LD A2,2,A3 FOUND, GET TABLE ADDRESS IN A2
RB UNP465
EJECT
************************************************************************
* *
* *
* *
* MOVMSK: ROUTINE TO MOVE A MASK TABLE TO "FLDTAB". *
* *
* *
* *
************************************************************************
* CALLING SEQUENCE: CF A14,MOVMSK*
* A2 = ADDRESS OF MASK TABLE*
**
MOVMSK EQU *
LD A5,2,A2 GET TABLE END ADDRESS
LD A3,FLDTAB,A4 DESTINATION ADDRESS
UNP480 EQU *
LDR* A1,A2 GET A WORD
STR A1,A3
ADK A3,2 UPDATE POINTERS
ADK A2,2
CWR A2,A5 FINISHED
RB(L) UNP480 NO
RTN A14 FINISHED RETURN TO CALLER
FILCUR EQU *
LDK A5,1 ENTRY COUNTER = 1
LD A3,FLDTAB,A4 GET START OF FIELD TABLE
LDKL A2,CURSAV GET SAVE AREA
ADR A2,A4
LDR* A1,A2 GET NUMBER OF INPUT FIELDS
SRL A1,1 DIVIDE IT X2
STR A1,A3 PUT IT IN FLD =TAB
ADK A3,8 MOVE POINTER TO FIELD DESCR.
ADK A2,2 GET CURSOR POS.
UNP490 EQU *
CW* A5,FLDTAB,A4 END OF WORK
RF(G) UNP495 YES, GO BACK
LDR* A1,A2 GET CUR. POS.
STR A1,A3 PUT IT IN FLDTAB
ADK A2,2 UPDATE POINTERS
ADK A3,8
ADK A5,1
RB UNP490 CONTINUE
UNP495 EQU *
RTN A14
EJECT
************************************************************************
* *
* *
* *
* UNP500 *
* *
* *
* *
************************************************************************
UNP500 EQU *
LD A1,INBUF,A4 INITIALIZE THE POINTERS
LD A3,OUTBUF,A4
ADK A3,1 SKIP TERM. ADDR. + KEYS
LD A5,FLDTAB,A4
LD A6,OUTBUF,A4 BASE FOR POSITION COMPUTATION
ADK A5,10 FIRST ENTRY IN TABLE
LDK A7,0 NUMBER OF CHARACTERS CHECKED
UNP510 EQU *
LCR A2,A1 SEARCH FOR INPUT FIELDS
CCK A2,SI START OF INPUT FIELD?
RF(E) UNP530 YES,MOVE IT
UNP520 EQU *
ADK A7,1 NO LOOK FURTHER
ADK A1,1
CW A7,INLEN,A4 END?
RB(L) UNP510 NO, CONTINUE
UNP525 EQU *
SUR A3,A6 COMPUTE TOTAL LENGTH
LD A10,OUTLEN,A4 GET ADDR. OF LENGTH ITEM
STR A3,A10 FILL IT
SUR A9,A6 CORRECT THE LAST FIELD
SUR A3,A9
LDR A9,A3 KEEP IT FOR 'INFLNG'.
CF A14,INFLNG INSERT FIELD LENGTHS IN FLDTAB
RTN A14 RETURN TO CALLER
UNP530 EQU *
LDR A9,A3 SAVE FOR LAST FIELD.
SUR A3,A6 COMPUTE POSITION
STR A3,A5 PUT IT IN FLDTAB
ADK A5,8 MOVE POINTER TO NEXT ENTRY
ADR A3,A6 RESTORE ADDRESS IN BUFFER
ADK A1,1 MOVE PAST "SI"
ADK A7,1 COUNT EM
UNP535 EQU *
CW A7,INLEN,A4 END OF INPUT
RB(G) UNP525 YES, STOP
LCR A2,A1 GET THE CHARACTER
CCK A2,SO END OF INPUT FIELD?
RF(E) UNP540 YES
CCK A2,LF OTHER END CHARS.
RF(E) UNP540
CCK A2,CR
RF(E) UNP540
UNP537 EQU *
CWK A2,/00 WAS IT NILL?
RF(E) UNP538
LD A11,-4,A5 SET THE MODIFIED BIT
ORKL A11,/2000
ST A11,-4,A5
UNP538 EQU *
SCR A2,A3 NO, PUT IT IN OUTPUT BUFFER
ADK A3,1 UPDATE POINTERS
ADK A1,1
ADK A7,1 NUMBER OF CHARS. MOVED
RB UNP535
UNP540 EQU *
ADK A1,1 MOVE PAST "SO"
ADK A7,1 COUNT EM
RB UNP510 GET THE NEXT FIELD
INFLNG EQU *
LD A5,FLDTAB,A4 GET FLDTAB
LDR* A6,A5 NUMBER OF FIELDS
ADK A5,10 MOVE TO FIRST ENTRY
LDR A3,A5 ANOTHER POINTER
ADK A3,8 TO NEXT ENTRY
LDK A7,1 FIELD COUNTER
UNP550 EQU *
LDR* A1,A3 GET THE POS'S.
LDR* A2,A5
SUR A1,A2 COMPUTE THE LENGTH
ST A1,2,A5 PUT IT IN TABLE
ADK A7,1 COUNT IT.
CWR A7,A6 END?
RF(G) UNP560 YES ,RETURN
ADK A5,8 UPDATE POINTERS
ADK A3,8
RB UNP550 CONTINUE
UNP560 EQU *
ST A9,2,A5 LAST FIELD CORRECTION
RTN A14 GO BACK TO CALLER
EJECT
************************************************************************
* *
* *
* *
* UNP600 *
* *
* *
* *
************************************************************************
UNP600 EQU *
LDK A6,0 INITIALIZE SPACE COUNTER
LD A8,GPECB,A4 GET PRINTER BUFFER ADDRESS
LD A3,ECBBA,A8
LDKL A2,LF MOVE TICKET TO FIRST LOGICAL LINE
SCR A2,A3
ADK A3,1
LD A1,INBUF,A4 GET INPUT BUFFER
LD A5,INLEN,A4 AND LENGTH
ADR A5,A1 END OF BUFFER
LDK A7,1 INITIALIZE LINE COUNTER
UNP610 EQU *
CWR A1,A5 END OF BUFFER?
RF(G) UNP620 YES, RETURN
LCR A2,A1 GET A CHARACTER
CF A14,CHARCN PROCESS IT
LDR A2,A2 IF ZERO, SKIP IT
RF(Z) UNP615 MUST HAVE BEEN = "SI" OR "SO".
CWK A7,3 DON'T FILL BUFFER UNTIL LINE=3
RF(L) UNP615
SCR A2,A3 PUT IT IN PRINTER BUFFER
ADK A3,1 UPDATE POINTERS
UNP615 EQU *
ADK A1,1
RB UNP610 GET THE NEXT ONE
UNP620 EQU *
LD A5,ECBBA,A8 CALCULATE LENGTH
SUR A3,A5
ST A3,ECBRL,A8 PUT IT IN ECB
RTN A14 FINISHED, RETURN TO CALLER
EJECT
CHARCN EQU *
CCK A2,SPACES THE CHECK FOR TEST PICTURE
RF(NE) UNP640 TEST PIC. IF MORE THAT 40
ADK A6,1 COUNT THE SPACE
RF UNP670 PUT IN BUFFER IF LINE > 3
UNP640 EQU *
CWK A6,40 MORE THAN 40 SPACES?
RF(NG) UNP642 NO, PROCESS
LDKL A9,2 THIS IS FIRST NON-SPACE AFTER
CF A14,MLF600 MORE THAN 40 SPACES
SUK A1,1 LET HIM PROCESS THIS AGAIN.
LDK A6,0 CLEAR THE COUNTER
RF UNP670 GO ON.
UNP642 EQU *
LDK A6,0 RESET SPACE COUNTER
CCK A2,NULL IF "NULL" REPLACE WITH SPACE
RF(NE) UNP650
LDK A2,SPACE
RF UNP670
UNP650 EQU *
CCK A2,SO IF "SO", SKIP IT
RF(NE) UNP652
LDK A2,0
RF UNP670
UNP652 EQU *
CCK A2,SI IF "SI", SKIP IT
RF(NE) UNP654
LDK A2,0
RF UNP670
UNP654 EQU *
CCK A2,LF IF LINE FEED, INSERT LF-CR
RF(NE) UNP656
UNP655 EQU *
LDKL A9,1 "1" LINE FEED, CARRIAGE RETURN
CF A14,MLF600 INSERT IN OUTPUT BUFFER
RF UNP670
UNP656 EQU *
CCK A2,CR IF CARRIAGE RETURN, THEN "LF"
RB(E) UNP655
CCK A2,MLF2 IF MULTIPLE LINE FEEDS
RF(NE) UNP658
LDKL A9,2
CF A14,MLF600 PUT 'EM IN OUTPUT BUFFER
RF UNP670
UNP658 EQU *
CCK A2,MLF6 IF MULTIPLE LINE FEEDS
RF(NE) UNP660
LDKL A9,6
CF A14,MLF600 PUT 'EM IN OUTPUT BUFFER
RF UNP670
UNP660 EQU *
CCK A2,PRTCHR IF ":", INSERT LINE FEEDS
RF(NE) UNP670
LDKL A9,21
SUR A9,A7 CALCULATE 'TOP-OF-FORM'
CF A14,MLF600
UNP670 EQU *
RTN A14
MLF600 EQU *
LDKL A2,CRLF
UNP680 EQU *
SCR A2,A3
ADK A3,1 UPDATE POINT
ADK A7,1 INCREASE LINE COUNTER
SUKL A9,1 SEE IF FINISHED
RF(Z) UNP682 YES
RB UNP680 NO, INSERT ANOTHER LF
UNP682 EQU *
SRL A2,8 FINISHED, GET CARRIAGE RETURN
RTN A14 LET MAIN ROUTINE INSERT IT
EJECT
************************************************************************
* *
* *
* *
* UNP700 *
* *
* *
* *
************************************************************************
UNP700 EQU *
* TEST STATUS OF PRINTER*
LDK A7,STATUS ORDER TEST STATUS
LD A8,GPECB,A4 ECB ADDRESS TO A8
LKM I/O
DATA 1
LD A1,ECBRC,A8 GET RETURN CODE
RF(Z) UNP710 NORMALLY ENDED
UNP705 EQU *
ST A1,PRINT,A4 RETURN NOT OK, SAVE IT
RTN A14 RETURN TO CALLER
UNP710 EQU *
LDK A7,/05 BASIC WRITE, NO-WAIT
UNP720 EQU *
LKM
DATA 1
LD A1,WORK3,A4 SEE IF FLASHING REQUIRED
RF(Z) UNP730 NO WIAT FOR PRINTER
UNP725 EQU *
CF A14,PFLASH FLASH THE FIELDS
LD* A1,GPECB,A4 PRINTER FINISHED ?
RB(NN) UNP725 NO, KEEP FLASHING
UNP730 EQU *
LD A8,GPECB,A4 SET UP WAIT
LKM
DATA 2
LD A1,ECBRC,A8 GET THE RETURN CODE
RB UNP705 RETURN
EJECT
************************************************************************
* *
* *
* *
* UNP800 *
* *
* *
* *
************************************************************************
UNP800 EQU *
LD A1,PRINT,A4 CHECK RETURN CODE FROM
PRINT ROUTINE
RF(NZ) UNP810 SEND NAK
LDK A2,ACK OK, SEND ACK
RF UNP815
UNP810 EQU *
LDK A2,NAK
UNP815 EQU *
LD A8,DCECB,A4 GET THE DC ECB
LD A3,ECBBA,A8 GET THE BUFFER
ADK A3,1 SKIP TERM. ADD ANK KEY INFO
SCR A2,A3 INSERT ACKNOWLEDGEMENT
LDK A7,100 WAIT 10 SECONDS
ST A7,ECBCW,A8 SAVEIN ECB
LDK A7,/B9 SETIME
LKM
DATA 1
LDK A7,2 LENGTH OF ACK-NAK
ST A7,ECBRL,A8
LDK A7,DCWRT FILL IN ORDER, WRITE
LKM I/O
DATA 1
RTN A14 RETURN TO CALLER
EJECT
************************************************************************
**
* THIS MODULE SCANS THE INPUT BUFFER TO SEE IF FLASHING*
* FIELDS ARE PRESENT. IF SO, A TABLE "FLATAB" IS BUILT.*
* FLATAB IS PLACED IN THE WORK AREA "CURSAV".*
* WORK3 = 1 IF FLASHING FIELDS ARE PRESENT.*
**
************************************************************************
UNP900 EQU *
CM WORK3,A4 RESET FLASH FLAG
LD A3,INBUF,A4 SEE IF FIRST CHAR = SI
LCR A1,A3
ANK A1,/FF CLEAN THE LEFT HALF
CCK A1,SI
RF(NE) UNP915 IF NOT SI, RETURN
LDKL A9,FLATAB COULD BE FLASHING FIELDS
ADR A9,A4 INITIALIZE TABLE
LDR A5,A9 FIELD POINTER
ADK A5,2 SKIP NUMBER OF FIELDS
CM FLATAB,A4 RESET NUMBER OF FIELDS
LDKL A7,/0101 RESET CURSOR POSITION
LD A6,INLEN,A4
ADR A6,A3 END OF INPUT BUFFER
UNP905 EQU *
ADK A3,1 MOVE TO NEXT CHARACTER
LCR A1,A3
ANK A1,/FF CLEAN THE LEFT HALF
CF A14,FLACHK CHECK FOR FLASHING FIELDS
CWR A3,A6 END ?
RF(G) UNP910
RB UNP905 NO CONTINUE
UNP910 EQU *
LD A1,FLATAB,A4 SEE IF FLASHING FIELDS EXIST
RF(Z) UNP915
IM WORK3,A4 YES FLAG IT
UNP915 EQU *
RTN A14 FINISHED
EJECT
FLACHK EQU *
CCK A1,LF IF LINE FEED UPDATE CURSOR
RF(E) FLA000
CCK A1,CR IF CARRIAGE RETURN DITTO
RF(E) FLA000
CCK A1,SI IF SI THEN START OF FIELD
RF(E) FLA005
CCK A1,SO IF SO,SKIP IT
RF(E) FLARTN
ADK A7,1 UPDATE CURSOR POSITION
LDR A2,A7
ANK A2,/FF
CWK A2,/0028 END OF LINE ?
RF(NG) FLARTN NO CONTINUE
FLA000 EQU *
ADKL A7,/0100 CURSOR TO NEXT LINE
ANKL A7,/FF00
ADKL A7,/0001 POSITION 1
RF FLARTN
FLA005 EQU *
IM FLATAB,A4 COUNT THE FIELD
LDR A2,A3 SAVE POSITION TO CALCULATE
ADK A2,1 MOVE PAST SI
FLA010 EQU *
ADK A3,1 MOVE PAST SI
ST A3,FLINPO,A5 POINTS TO START OF FIELD
ST A7,FLACUR,A5 CURSOR POSITION
FLA015 EQU *
CWR A3,A6 END OF INPUT ?
RF(G) FLA025
LCR A1,A3 LOOK FOR END OF FIELD
CCK A1,SO END OF FIELD = SI, SO, CR, LF
RF(E) FLA020
CCK A1,SI
RF(E) FLA020
CCK A1,LF
RF(E) FLA020
CCK A1,CR
RF(E) FLA020
CCK A1,NULL IF NULL INSERT X'AE'
RF(E) FLA030
CCK A1,DKOE1 THE DANISH CONVERSIONS
RF(E) FLA035
CCK A1,DKAE1
RF(E) FLA040
CCK A1,DKAA1
RF(E) FLA045
FLA017 EQU *
ADK A7,1 UPDATE CURSOR
ADK A3,1 UPDATE POINTER
RB FLA015
FLA020 EQU *
SUR A2,A3 COMPUTE FIELD LENGTH
C1R A2,A2 MAKE IT POSITIVE
ADK A2,1 TWO'S COMPLEMENT
ST A2,FLALEN,A5 PUT LENGTH IN TABLE
ADK A5,6 POINTS TO NEXT FIELD
RF FLARTN
FLA025 EQU *
SUK A3,1 CORRECT FOR OVER-SHOOT
RB FLA020
FLA030 EQU *
LDK A1,POINT INSERT A .
SCR A1,A3
RB FLA017
FLA035 EQU *
LDK A1,DKOE2 THE END OF DANISH CONVERSIONS
SCR A1,A3
RB FLA017
FLA040 EQU *
LDK A1,DKAE2
SCR A1,A3
RB FLA017
FLA045 EQU *
LDK A1,DKAA2
SCR A1,A3
RB FLA017
FLARTN EQU *
RTN A14
EJECT
************************************************************************
**
* THIS MODULE WILL FLASH THE FIELDS ON A PDU*
* AS DESCRIBED BY THE TABLE FLATAB, WHICH GIVES*
* THE CURSOR POSITIONS, LENGTHS AND A POINTER TO*
* THE ORIGINAL CONTENTS...*
**
************************************************************************
KBFLSH EQU *
CF A14,I:EVA0 CREDIT ENTRY, GET WORK AREA
LDR A4,A9
LD A1,WORK3,A4 ANY FLASHING FIELDS?
RF(Z) FLAEND NO, EXIT AGAIN
PFLASH EQU *
ASSEMBLER ENTRY
LDKL A9,FLATAB GET THE TABLE
ADR A9,A4
LDR A5,A9 ENTRY POINTER
ADK A5,2 SKIP NUMBER OF FIELDS
LDK A6,1 INITIALIZE FIELD COUNTER
LD A8,DYECB,A4 GET DISPLAY ECB
CF A14,BLANK FIRST BLANK THE FIELDS
LDKL A8,3 WAIT 500 MILLI-SECONDS
LKM
DATA 6
LD A8,DYECB,A4 RETSORE A8
LDR A5,A9 RESET POINTER
ADK A5,2
LDK A6,1 AND COUNTER
CF A14,REWRIT RE-WRITE THE FIELDS
LDKL A8,3 WAIT 500 MILLI-SECONDS
LKM
DATA 6
FLAEND EQU *
RTN A14 RETURN TO CALLER
EJECT
BLANK EQU *
LDKL A1,BLANKS SET UP BUFFER
ADR A1,A4
LD A3,ECBBA,A8
ST A1,ECBBA,A8
BLK000 EQU *
CF A14,BLKFLD BLANK ONE FIELD
ADK A5,6 MOVE TO NEXT FIELD
ADK A6,1 COUNT IT
LD A1,FLATAB,A4 CHECK IF FINISHED
CWR A6,A1
RB(NG) BLK000 NO,CONTINUE
ST A3,ECBBA,A8
RTN A14 FINISHED
EJECT
BLKFLD EQU *
LD A2,ECBBA,A8 GET BUFFER ADDRESS
LDK A1,SETCUR SET CURSOR POSITION
SCR A1,A2 PUT IT IN BUFFER
ADK A2,1
LD A1,FLACUR,A5
ADKL A1,/1F1F MAKE CURS. POS DISPLAY
SCR A1,A2 PUT IN LINE NUMBER
ADK A2,1
SRL A1,8
SCR A1,A2 PUT IN COLUMN NUMBER
ADK A2,1
LDKL A1,FAST
LD A10,FLALEN,A5 GET LENGTH OF FIELD
ADR A1,A10
ECR A1,A1 PUT IT IN RIGHT ORDER
SCR A1,A2 IN BUFFER
ADK A2,1
SRL A1,8
SCR A1,A2
ADK A2,1
LDK A1,SPACE THE BLANKS
SCR A1,A2
LDK A1,6 SET UP REQUESTED LENGTH
ST A1,ECBRL,A8
CF 14,LINKUM WRITE IT...
RTN A14
EJECT
REWRIT EQU *
LD A10,ECBBA,A8 SAVE IT
REW000 EQU *
LD A2,FLINPO,A5 GET ORIGINAL DATA
SUK A2,3 MAKE ROOM FOR CURSOR POSITION
ST A2,ECBBA,A8
LDK A1,SETCUR
SCR A1,A2 PUT IT IN THERE
ADK A2,1
LD A1,FLACUR,A5
ADKL A1,/1F1F
SCR A1,A2
ADK A2,1
SRL A1,8
SCR A1,A2
LD A1,FLALEN,A5 GET THE FIELD LENGTH
ADK A1,3
ST A1,ECBRL,A8
CF A14,LINKUM WRITE IT...
ADK A5,6 UPDATE AND WRITE REST
ADK A6,1
LD A2,FLATAB,A4 CHECK END
CWR A6,A2
RF(G) REW100 YES, RETURN
RB REW000 NO, CONTINUE
REW100 EQU *
ST A10,ECBBA,A8 RESTORE BUFFER ADDR.
RTN A14
EJECT
LINKUM EQU *
LDK A7,/85 BASIC WRITE WITH WAIT
LKM
DATA 1
RTN A14
END